Build Array from Table, Create new Table

kpasa

Board Regular
Joined
Nov 20, 2015
Messages
82
I have the following code to cycle through a table and find rows that match a few pieces of critical criteria.
Code:
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?
 
Last edited:

Some videos you may like

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,384
Office Version
  1. 365
Platform
  1. Windows
Something like
Code:
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

Board Regular
Joined
Nov 20, 2015
Messages
82
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
Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,384
Office Version
  1. 365
Platform
  1. Windows
Glad to help & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,123,516
Messages
5,602,110
Members
414,503
Latest member
kerti

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top