excelvbaauto-populaterowdeleting

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


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.


Solution

  • 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