Adding Rows to Tables not specified in the If Statement

Question

I am trying to add values to the end of a table in Excel. When I run the Macro, a row is added to each of the tables, even through the values are only added to the table specified in the If Statement. Code is below:

Sub AddQuoteNumbers()

'ListObject is a Table in a Worksheet'
Dim tbl As ListObject
Dim tb2 As ListObject
Dim tb3 As ListObject

Set tbl = Worksheets("quote1").ListObjects("Table1")
Set tb2 = Worksheets("quote2").ListObjects("Table2")
Set tb3 = Worksheets("quote3").ListObjects("Table3")

'ListRows allows us to Add or Delete Rows'
Dim NewRow1 As ListRow
Dim NewRow2 As ListRow
Dim NewRow3 As ListRow

Set NewRow1 = tbl.ListRows.Add
Set NewRow2 = tb2.ListRows.Add
Set NewRow3 = tb3.ListRows.Add


If Worksheets("Template").Range("H5") = "quote1" Then
With NewRow1
    .Range(1) = Worksheets("Template").Range("B9")
    .Range(3) = Worksheets("Template").Range("B8")
    .Range(4) = Worksheets("Template").Range("H4")
    .Range(5) = Worksheets("Template").Range("B13")
End With
Else

If Worksheets("Template").Range("H5") = "quote2" Then
With NewRow2
    .Range(1) = Worksheets("Template").Range("B9")
    .Range(3) = Worksheets("Template").Range("B8")
    .Range(4) = Worksheets("Template").Range("H4")
    .Range(5) = Worksheets("Template").Range("B13")
End With
Else


If Worksheets("Template").Range("H5") = "quote3" Then
With NewRow3
    .Range(1) = Worksheets("Template").Range("B9")
    .Range(3) = Worksheets("Template").Range("B8")
    .Range(4) = Worksheets("Template").Range("H4")
    .Range(5) = Worksheets("Template").Range("B13")
End With


End If
End If
End If
End Sub

I only want a row to be added to the table specified by the If/With Statement.

If the value in H5 = "quote1" I only want it added to quote1 table.

Your code is _always_ running the `ListRows.Add` lines, so you're getting new rows _always_. But your logic to populate the new row(s) is contained with in an `if` statement, so the rows only get populated when certain conditions are met. — Marc, Dec 02 '22 at 20:48

VBasic2008 · Answer 1 · 2022-12-03T11:53:14.107

New Row (`ListRow`) in Excel Table (`ListObject`)

Step by Step

Sub AddQuoteNumbers()

    ' Define constants...
    Const SRC_NAME As String = "Template"
    Const SRC_DST_NAME_CELL As String = "H5"
    ' ... and pairs of constant arrays.
    Dim dwsNames() As Variant: dwsNames = VBA.Array("Quote1", "Quote2", "Quote3")
    Dim dloNames() As Variant: dloNames = VBA.Array("Table1", "Table2", "Table3")
    Dim dColumns() As Variant: dColumns = VBA.Array(1, 3, 4, 5)
    Dim sAddresses() As Variant: sAddresses = VBA.Array("B9", "B8", "H4", "H13")
    
    ' Reference the workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' From the source worksheet, retrieve the destination worksheet name...
    Dim sws As Worksheet: Set sws = wb.Sheets(SRC_NAME)
    Dim dwsName As String: dwsName = CStr(sws.Range(SRC_DST_NAME_CELL).Value)
    ' ...  and attempt to match it against the names in the 'dwsNames' array.
    Dim dwsIndex As Variant: dwsIndex = Application.Match(dwsName, dwsNames, 0)
    
    ' Check if there was no match. Then inform of failure and exit.
    If IsError(dwsIndex) Then
        MsgBox "Worksheet """ & dwsName & """ is not in the list:" _
            & vbLf & Join(dwsNames, vbLf), vbExclamation
        Exit Sub
    End If
    
    ' Since there was a match, add a new row in the destination table.
    Dim n As Long: n = CLng(dwsIndex) - 1 ' the arrays are zero-based
    Dim dws As Worksheet: Set dws = wb.Sheets(dwsName) ' = dwsNames(n)
    Dim dlo As ListObject: Set dlo = dws.ListObjects(dloNames(n))
    Dim dlr As ListRow: Set dlr = dlo.ListRows.Add
    
    ' Write the values from the source cells to the new destination table row.
    With dlr.Range
        For n = 0 To UBound(dColumns) ' = UBound(sAddresses)
            .Cells(dColumns(n)).Value = sws.Range(sAddresses(n)).Value
        Next n
    End With
    
    ' Inform of success.
    MsgBox "Added new row to table """ & dlo.Name & """ in worksheet """ _
        & dws.Name & """.", vbInformation
 
End Sub

Adding Rows to Tables not specified in the If Statement

1 Answers1

New Row (ListRow) in Excel Table (ListObject)

New Row (`ListRow`) in Excel Table (`ListObject`)