VBA to auto populate a table from data entered in another table

652 Views Asked by At

I'm an electrical contractor and I made a worksheet to help me bid projects. Say I'm bidding on wiring a new house. I have broken down each task "outlet"/"Switch" to materials and labor needed for each task. Those materials are then multiplied by the quantity needed and populate 3 different tables automatically.

Here is the process: (24 outlets are needed for this job)

"Bid Cut Sheet" Sheet where quantities of specific tasks are entered.

"Job List" Tasks are broken down into materials needed for that task, multiplied by the quantity entered in "Bid Cut Sheet"

"Material Sheet" Total of all material needed for the job in 3 different tables/stages of the project

What I am trying to do is populate rows in EACH table where materials are needed. Essentially consolidate the data in EACH table by eliminating with quantities of 0 and ADDING rows with quantities >0 and fill down rows with material needed: updating every time data is entered in the "Bid Cut Sheet"

This code eliminates values of 0 after I run the code, but does not update data entered in the "bid cut sheet" after I run the code. Also, I would like this to be imbedded in the workbook so I dont have to run the code each time I use the workbook.

Sub DeleteRowsBasedonCellValue()
'Declare Variables
Dim i As Long, LastRow As Long, Row As Variant
Dim listObj As ListObject
Dim tblNames As Variant, tblName As Variant
Dim colNames As Variant, colName As Variant
                'Names of tables
tblNames = Array("Rough_Material", "Trim_Material", "Service_Material")
colNames = Array("Rough", "Trim", "Service")
                

'Loop Through Tables
For i = LBound(tblNames) To UBound(tblNames)
    tblName = tblNames(i)
    colName = colNames(i)
    Set listObj = ThisWorkbook.Worksheets("MaterialSheet").ListObjects(tblName)
    'Define First and Last Rows
    LastRow = listObj.ListRows.Count
    'Loop Through Rows (Bottom to Top)
    For Row = LastRow To 1 Step -1
        With listObj.ListRows(Row)
            If Intersect(.Range, _
            listObj.ListColumns(colName).Range).Value = 0 Then
                .Delete
            End If
        End With
    Next Row
Next i

End Sub

This is what it looks like after running the code, it works one time but does not update.

1

There are 1 best solutions below

9
On BEST ANSWER

If I understand your question correctly, what you are looking for is something like this:

Sub DeleteRowsBasedonCellValue()
    'Declare Variables
    Dim LastRow As Long, FirstRow As Long
    Dim Row As Long
    Dim columns As Variant, column As Variant
    
    columns = Array("A", "D", "G")
    
    With ThisWorkbook.Worksheets("Sheet1") '<- type the name of the Worksheet here
        'Define First and Last Rows
        FirstRow = 1
        LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        
        'Loop Through Columns
        For Each column In columns
            'Loop Through Rows (Bottom to Top)
            For Row = LastRow To FirstRow Step -1
                If .Range(column & Row).Value = 0 Then
                    .Range(column & Row).Resize(1, 2).Delete xlShiftUp
                End If
            Next Row
        Next column
    End With
End Sub

Test it out and see if this does what you want.

Alternatively, it might be wiser to be more explicit and make the code more flexible. If your tables are actually formatted as tables, you can also loop over these so-called ListObjects. That way, if you insert columns/rows in the future, the code won't break.

To do this, you could use code like this:

Sub DeleteRowsBasedonCellValue()
    'Declare Variables
    Dim i As Long, LastRow As Long, Row As Variant
    Dim listObj As ListObject
    Dim tblNames As Variant, tblName As Variant
    Dim colNames As Variant, colName As Variant
                    'The names of your tables
    tblNames = Array("Rough_Materials", "Trim_Materials", "Service_Materials")
    colNames = Array("quantity_rough", "quantity_trim", "quantity_service")
                    'The name of the column the criterion is applied to inside each table
    
    'Loop Through Tables
    For i = LBound(tblNames) To UBound(tblNames)
        tblName = tblNames(i)
        colName = colNames(i)
        Set listObj = ThisWorkbook.Worksheets("Sheet1").ListObjects(tblName)
        'Define First and Last Rows             '^- the name of the Worksheet
        LastRow = listObj.ListRows.Count
        'Loop Through Rows (Bottom to Top)
        For Row = LastRow To 1 Step -1
            With listObj.ListRows(Row)
                If Intersect(.Range, _
                listObj.ListColumns(colName).Range).Value = 0 Then
                    .Delete 
                End If
            End With
        Next Row
    Next i
End Sub

Edit in response to your comment:

Make sure your table is actually formatted as a table and has been given the right name! You can also change the table names in your code to your liking in the line tblNames = Array("Rough_Materials", "Trim_Materials", "Service_Materials"). Also, the column names have to be correct/you should adapt them in the code: colNames = Array("quantity_rough", "quantity_trim", "quantity_service")

enter image description here