CODEWITHSUNDEEP
excelvbaexcel-formula
Jo365
Jo365

Reputation: 69

VBA Code to generate a dynamic excel formula

I have a script that inserts a new row into the table I have in an Excel sheet. There is formulas in the sheet from the range H:L. This formula compares some values against the previous cells. The first row in the table contains this formula

*H8: =IF(A8<>"",IF(C8<>"",(1-C8),1),"")
I8: =IF(A8<>"",IF(D8<>"",(1-D8),1),"")*

and so on to L8. The second row and any new rows getting added below should have this formula

*L9 =IF(A9<>"",IF(G9<>"",L8*(1-G9),IF(L8<>"",L8,"")),"")
L10=IF(A10<>"",IF(G10<>"",L9*(1-G10),IF(L9<>"",L9,"")),"")
L11=IF(A11<>"",IF(G11<>"",L10*(1-G11),IF(L10<>"",L10,"")),"")
L12=IF(A12<>"",IF(G12<>"",L11*(1-G12),IF(L11<>"",L11,"")),"")*

... and so on. My VBA script works well to insert the row and to copy the formulas to the new row... but the formula is always =IF(A9<>"",IF(G9<>"",L8*(1-G9),IF(L8<>"",L8,"")),"") , and not dynamic to change the cell references based on the new row. Below is the code I have. Not sure what is wrong in it. Is there a way someone can help please

enter image description here

Sub InsertNewRow()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim newRow As ListRow
    Dim password As String
    Dim i As Long
    Dim newRowNumber As Long
    
    ' Set the password for protection
    password = "12345"
    
    ' Set the worksheet that contains the table
    Set ws = ThisWorkbook.Worksheets("Template") ' Replace "Template" with the actual sheet name
    
    ' Set the table (replace "Table2" with the actual table name)
    Set tbl = ws.ListObjects("Table2")
    
    ' Check if the worksheet is protected
    If ws.ProtectContents Then
        ' Unprotect the worksheet with the provided password
        ws.Unprotect password
    End If
    
    ' Insert a new row below the last row of the table
    Set newRow = tbl.ListRows.Add
    newRowNumber = newRow.Index
    
    ' Clear the data values in the new row for columns A to G
    With newRow.Range
        .Offset(1).Resize(1, 7).ClearContents
    End With
    
    ' Set formulas for columns H to L in the new row with adjusted references
    For i = 1 To 5
        newRow.Range.Cells(1, 7 + i).Formula = Replace(tbl.ListColumns(7 + i).DataBodyRange.Cells(newRowNumber - 1).Formula, "$A$9", "A" & newRowNumber)
        newRow.Range.Cells(1, 7 + i).Formula = Replace(newRow.Range.Cells(1, 7 + i).Formula, "$G$9", "G" & newRowNumber)
        newRow.Range.Cells(1, 7 + i).Formula = Replace(newRow.Range.Cells(1, 7 + i).Formula, "$L$8", "L" & (newRowNumber - 1))
        newRow.Range.Cells(1, 7 + i).Formula = Replace(newRow.Range.Cells(1, 7 + i).Formula, "$L" & (8 + i - 1), "L" & newRowNumber)
    Next i
    
    ' Protect the worksheet back with the provided password
    If ws.ProtectContents Then
        ws.Protect password
    End If
End Sub

Upvotes: 1

Views: 154

Answers (1)

taller
taller

Reputation: 18778

  • A small modification to the formula would make it easier to fill or copy down to multiple cells in the worksheet.

H8: =IF($A8<>"",IF(C8<>"",(1-C8),1),"")

I8: =IF($A8<>"",IF(D8<>"",(1-D8),1),"")

L9: =IF($A9<>"",IF(G9<>"",L8*(1-G9),IF(L8<>"",L8,"")),"")

  • You don't have to set formula on inserted row (except row 9) if the formula is same as above.. The formula in ListObject will automatically fill it.
Sub InsertNewRow()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim newRow As ListRow
    Dim password As String
    Dim i As Long
    Dim newRowNumber As Long
    Application.AutoCorrect.AutoFillFormulasInLists = False
    ' Set the password for protection
    password = "12345"
    ' Set the worksheet that contains the table
    Set ws = ThisWorkbook.Worksheets("Template") ' Replace "Template" with the actual sheet name
    ' Set the table (replace "Table2" with the actual table name)
    Set tbl = ws.ListObjects("Table2")
    ' Check if the worksheet is protected
    If ws.ProtectContents Then
        ' Unprotect the worksheet with the provided password
        ws.Unprotect password
    End If
    ' Insert a new row below the last row of the table
    Set newRow = tbl.ListRows.Add
    ' Get row number with Range.Row
    newRowNumber = newRow.Range.Row
    ' Clear the data values in the new row for columns A to G
    Cells(newRowNumber, 1).Offset(1).Resize(1, 7).ClearContents
    ' Set formula with FormulaR1C1
    ' Set formulas for columns H to L in the new row with adjusted references
    If newRowNumber > 8 Then
        Cells(newRowNumber, "H").Resize(1, 5).FormulaR1C1 = "=IF(RC1<>"""",IF(RC[-5]<>"""",R[-1]C*(1-RC[-5]),IF(R[-1]C<>"""",R[-1]C,"""")),"""")"
    End If
    ' Protect the worksheet back with the provided password
    If ws.ProtectContents Then
        '        ws.Protect password
    End If
End Sub

Row 10 is inserted with code. enter image description here

Upvotes: 2

Related Questions