Build Array from Table, Create new Table

[kpasa]

I have the following code to cycle through a table and find rows that match a few pieces of critical criteria.

Sub FocusMissingAction()    
    Dim tbl As ListObject
    Dim cell As Range
    
    Set tbl = ActiveSheet.ListObjects("Table1")

    For Each cell In tbl.ListColumns(1).DataBodyRange.Cells
        If cell.Offset(0, 27) = "" And cell.Offset(0, 2) < Date And (cell.Offset(0, 10) = "" Or cell.Offset(0, 11) = "" Or cell.Offset(0, 23) = "") Then
            'Add Certain cells in this row to a new array, maybe 6-8 cells
            'for example, add cell and cell.offset(0,30) and cell.offset(0,31) to the array or collection. 
            'the number of columns I'll pull data from will not change, but the number of rows that match the criteria above will certainly change
        Else
        End If
    Next
    
    'create a new table for emailing to colleague
    'use same info to display on a userform. Not for editing, just for quick viewing
End Sub

I need to know how pull the specific cells from the matched row and continue to add to the array for all the matched rows.

After that, I'm looking to do two things:

1. Use the array to build a new table on a different sheet (required)
2. Use the array to feed into a userform for quick viewing (not necessary, but nice-to-have)

Anyone have anything similar or can you offer some direction?

 

[Fluff]

Something like

Sub FocusMissingAction()
   Dim tbl As ListObject
   Dim cell As Range
   Dim Nary As Variant, r As Long
   
   Set tbl = ActiveSheet.ListObjects("Table2")
   ReDim Nary(1 To tbl.ListColumns(1).DataBodyRange.Cells.Count, 1 To 4)
   For Each cell In tbl.ListColumns(1).DataBodyRange.Cells
      If cell.Offset(0, 27) = "" And cell.Offset(0, 2) < Date And (cell.Offset(0, 10) = "" Or cell.Offset(0, 11) = "" Or cell.Offset(0, 23) = "") Then
      r = r + 1
      Nary(r, 1) = cell: Nary(r, 2) = cell.Offset(, 15): Nary(r, 3) = cell.Offset(, 26): Nary(r, 4) = cell.Offset(, 5)
      End If
   Next
   With Sheets("sheet2")
      .Range("A1").Resize(r, 4).Value = Nary
      .ListObjects.Add(xlSrcRange, Range("A1").Resize(r, 4), , xlYes).name = "Table1"
   End With
End Sub

 

[kpasa]

This worked perfectly. And it's really clear on what it's doing so, I'll be able to customize it very easily. Thank you so much!!

Something like

Sub FocusMissingAction()
   Dim tbl As ListObject
   Dim cell As Range
   Dim Nary As Variant, r As Long
   
   Set tbl = ActiveSheet.ListObjects("Table2")
   ReDim Nary(1 To tbl.ListColumns(1).DataBodyRange.Cells.Count, 1 To 4)
   For Each cell In tbl.ListColumns(1).DataBodyRange.Cells
      If cell.Offset(0, 27) = "" And cell.Offset(0, 2) < Date And (cell.Offset(0, 10) = "" Or cell.Offset(0, 11) = "" Or cell.Offset(0, 23) = "") Then
      r = r + 1
      Nary(r, 1) = cell: Nary(r, 2) = cell.Offset(, 15): Nary(r, 3) = cell.Offset(, 26): Nary(r, 4) = cell.Offset(, 5)
      End If
   Next
   With Sheets("sheet2")
      .Range("A1").Resize(r, 4).Value = Nary
      .ListObjects.Add(xlSrcRange, Range("A1").Resize(r, 4), , xlYes).name = "Table1"
   End With
End Sub

 

[Fluff]

Glad to help & thanks for the feedback