Filtering data in table1 on sheet1 and copying specific columns into table2 on sheet2-CodePudding

I'm new to Excel VBA. I have a table1 on sheet1, I need to filter rows of table1 based on one of the columns of table1 using a string. Then from the filtered rows I need to copy the data from specific columns and paste/insert the data under the same header names in table2 located in sheet2. I'm looking to update sheet2 constantly as changes are made in sheet1 as the table doesn't have a fixed number of rows.

This is the table I'm working with Food and Electronics Stock

Any help is appreciated, thanks.

Sub UpdateTable()

Dim myTable1 As ListObject
Dim myArray1 As Variant
Dim myTable2 As ListObject


Set myTable1 = Worksheets("Sheet1").ListObjects("table1")
Set myArray1 = myTable.ListColumns(3).Range
Set myTable2 = Worksheets("Sheet2").ListObjects("table2")
'Need to include other variables

For Each cell In myArray1
    If cell.Value = "FOOD" Then 'copy paste data under Item, Quantity and Cost into table2 located in sheet2
        
Next cell

End Sub

Edit: Modified Code

Option Explicit

Sub UpdateTable()

With Sheets("foodSheet").ListObjects("tableFood")
    'Check If any data exists in the table
    If Not .DataBodyRange Is Nothing Then
        'Clear Content from the table
        .DataBodyRange.ClearContents
    End If
End With

'Delete empty rows and shift cells up
Dim i As Long
With Sheets("foodSheet").ListObjects("tableFood").DataBodyRange
    For i = .Rows.Count To 1 Step -1
        If IsEmpty(.Cells(i, 1)) Then .Rows(i).Delete shift:=xlUp
    Next
End With

Dim col, r As Long, rng As Range
 ' apply filter
With Sheet1.ListObjects("tableStock").Range
    .AutoFilter Field:=3, Criteria1:="FOOD"
    Set rng = .SpecialCells(xlCellTypeVisible)
End With

' check number of rows visible
If rng.Rows.Count > 1 Or rng.Areas.Count > 1 Then
    With Sheet2.ListObjects("tableFood")
        ' count existing rows in table 2
        If .InsertRowRange Is Nothing Then
            r = .Range.Rows.Count
        Else
            r = 1
        End If
    End With
    For Each col In Array("[Item]", "[Quantity]", "[Cost]")
        Sheet1.Range("tableStock" & col).Copy Sheet2.Range("tableFood" & col).Rows(r)
    'Need to shift cells of table down when pasting in the data
    Next
End If

End Sub

CodePudding user response：

Option Explicit

Sub UpdateTable2()

    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Sheet1 ' Sheets("tablestock") ?
    Set ws2 = Sheets("foodSheet")
 
    ' Clear Content from the table
    With ws2.ListObjects("tableFood")
        If Not .DataBodyRange Is Nothing Then
            .DataBodyRange.Rows.Delete
        End If
    End With

    Dim a, col, rng As Range, r As Long, n As Long
     ' apply filter
    With ws1.ListObjects("tableStock").Range
        .AutoFilter Field:=3, Criteria1:="FOOD"
        Set rng = .SpecialCells(xlCellTypeVisible)
    End With
    
    ' count visible rows
    For Each a In rng.Areas
        r = r   a.Rows.Count
    Next

    ' check for data
    If r > 1 Then
       ' expand table2 space
        With ws2.ListObjects("tableFood")
            If r > 2 Then
                .Range.Offset(2).Resize(r - 2).EntireRow.Insert
                .Resize .Range.Resize(r)
            End If
        End With

        ' copy data
        For Each col In Array("[Item]", "[Quantity]", "[Cost]")
            ws1.Range("tableStock" & col).Copy ws2.Range("tableFood" & col)
        Next
    End If

End Sub