The source workbook has a worksheet that has 32 columns, and the number rows are dynamic. There will be a column with a value of “Y” or “N”. For each “Y” I need to write that row into an array, even the null cells. The columns header starts are cell “A6” and the details on “A7”.
Next to paste the array into an actual table in a different worksheet. This will happen periodically, and the values will need to be replaced in the table when the user updates the source.
- Create array from source
- Clear table in destination worksheet
- Paste array in table in destination worksheet
Problem is I’m getting no values in the array, and I’m still trying to grasp arrays in general, so any help will be appreciated. The code below is from a small range I was working on for testing purposes.
Sub CopyToDataset()
Dim datasetWs As Worksheet
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim cell As Range, rng1 As Range, rng2 As Range, row As Range
Dim ArrayofAJobs() As Variant
Dim ArrayofACCJobs() As Variant
Dim myData As Range
Dim i As Long
Dim j As Long
Dim k As Long
Dim LastRowWs1 As Long
Dim LastRowWs2 As Long
Set ws1 = ThisWorkbook.Worksheets("Src")
' Find the last row with data.
LastRowWs1 = LastRow(ws1)
k = 1
With ws1
ReDim ArrayofAJobs(6, k)
For i = 2 To LastRowWs1
If UCase(Cells(i, 1)) = "Y" Then
For j = 2 To 4
If IsNull(ArrayofAJobs(j, k)) Then ArrayofAJobs(j, k) = vbNullString
ArrayofAJobs(j, k) = Cells(i, j).Value
Next j
k = k + 1
ReDim Preserve ArrayofAJobs(4, k)
End If
Next i
End With
ArrayofAJobs() = TransposeArray(ArrayofAJobs)
With ThisWorkbook.Worksheets("Dest")
.Range("A6") = ArrayofAJobs()
End With
End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).row
On Error GoTo 0
End Function
Public Function TransposeArray(myarray As Variant) As Variant
Dim X As Long
Dim Y As Long
Dim Xupper As Long
Dim Yupper As Long
Dim tempArray As Variant
Xupper = UBound(myarray, 2)
Yupper = UBound(myarray, 1)
ReDim tempArray(Xupper, Yupper)
For X = 0 To Xupper
For Y = 0 To Yupper
tempArray(X, Y) = myarray(Y, X)
Next Y
Next X
TransposeArray = tempArray
End Function
===================================================================
Version 2: I’m getting the runtime error 9: subscript out of range.
Sample Source:
Option Explicit
Option Base 1
Sub CopyToDataset()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim destWkb As Workbook
Dim cell As Range, rng1 As Range, rng2 As Range, row As Range
Dim ArrayofAJobs() As Variant
Dim ArrayofACCJobs() As Variant
Dim i As Long
Dim j As Long
Dim k As Long
Dim LastRowWs1 As Long
Dim LastRowWs2 As Long
k = 1
Const startRow As Long = 6
Set ws1 = ThisWorkbook.Worksheets("Src")
' Find the last row with data on ws1.
LastRowWs1 = LastRow(ws1)
Debug.Print LastRowWs1
With ws1
ReDim ArrayofAJobs(i, 32)
For i = 1 + startRow To LastRowWs1 'Number of rows starting at row 6. Details start on row 7.
If UCase(.Cells(i, 1)) = "Y" Then
For j = 1 To 32 'Number of columns starting on column A
If IsNull(ArrayofAJobs(i, j)) Then ArrayofAJobs(i, j) = vbNullString
ArrayofAJobs(i, j) = .Cells(i, j).Value
Next j
End If
Next i
End With
With ThisWorkbook.Worksheets("Dest")
.Range(.Cells(2, 1), .Cells(UBound(ArrayofAJobs, 1), UBound(ArrayofAJobs, 2))) = ArrayofAJobs()
End With
End Sub
Without seeing the workbook, I’m not 100% sure I followed you exactly, but I do see a few things that I would change.
-
You need to add a “.” before
Cells
. That dot ensures that the cells that you’re picking up are fromws1
and not the active sheet.If UCase(.Cells(i, 1)) = "Y" Then ArrayofAJobs(j, k) = .Cells(i, j).Value
-
The watch window didn’t have any of the array elements expanded so I we can’t see that the array is actually empty. But, you cannot
Redim Preserve
the first dimension of an array.ReDim ArrayofAJobs(6, k) ReDim Preserve ArrayofAJobs(4, k) 'This line should cause a Runtime Error 9.
It looks like you need to change the first
ReDim
toArrayofAJobs(**4**, k)
. -
When you “paste” an array, you have to specify the entire range that it’s going to be “pasted” to. It’s not like pasting a range of copied cells where you can tell Excel the top, left cell and it figures out the rest. So you would need to change your code from
.Range("A6") = ArrayofAJobs()
to this.
.Range(.Cells(6, 1), .Cells(UBound(ArrayofAJobs, 1), UBound(ArrayofAJobs, 2))) = ArrayofAJobs
Tags: arraysexcel, dynamic