title: Create Dynamic Array on Criteria and Paste to Worksheet
body: <p>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".</p>
  
  <p>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. </p>
  
  <ol>
  <li>Create array from source</li>
  <li>Clear table in destination worksheet</li>
  <li>Paste array in table in destination worksheet</li>
  </ol>
  
  <p>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.</p>
  
  <p><a href="https://i.stack.imgur.com/pmMkX.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/pmMkX.png" alt="enter image description here"></a></p>
  
  <pre><code>    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
  </code></pre>
  
  <p>===================================================================</p>
  
  <p>Version 2: I'm getting the runtime error 9: subscript out of range.</p>
  
  <p><a href="https://i.stack.imgur.com/k4JU6.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/k4JU6.png" alt="enter image description here"></a></p>
  
  <p>Sample Source:</p>
  
  <p><a href="https://i.stack.imgur.com/zuFdY.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/zuFdY.png" alt="enter image description here"></a></p>
  
  <p><a href="https://i.stack.imgur.com/e0tqE.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/e0tqE.png" alt="enter image description here"></a></p>
  
  <pre><code>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
  </code></pre>