Add total row with a loop

[gberg]

I have a table that I want to add "TOTAL" rows for two rows down from any instance of "SUBCONTRACT". I have the following code but it just keeps going to the first instance of "SUBCONTRACT" and keeps adding a TOTAL row only for the first instance of SUBCONTRACT. I would like it to continue down the column and add the TOTAL row for each instance of SUBCONTRACT, not just the first one. Any help would be appreciated.

Sub Ttl_Row()
    '**********Move the ttCatSum values to the proper columns
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
   
    ' Set the worksheet where your data is located
    Set ws = ThisWorkbook.Sheets("Job Cost Analysis Report")
   
    ' Find the last row with data in column A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
   
    ' Loop through each row until the last row with data
    For i = 1 To lastRow
        'Find 1 in Job Column
        Dim ing As Range
        Dim str As String
        Set ing = Sheets("Job Cost Analysis Report").Range("TBL_JCAR[Description]").Find("SUBCONTRACT", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
        'If Not rng Is Nothing Then
        On Error GoTo NextStep
        str = ing.Address
        Range(str).Select
        'End If
       
        'Insert Total Row
        ActiveCell.Offset(2, 0).EntireRow.Insert
        ActiveCell.Offset(2, 0).Select
        ActiveCell.Value = "TOTAL"

'        Intersect(ActiveCell.EntireRow, ActiveCell.CurrentRegion).Font.Bold = True
    Next i

NextStep:
    Range("TBL_JCAR[[#Headers],[Job]]").Offset(1, 0).Select

End Sub

 

[Peter_SSs]

When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.

 

[gberg]

Will do in the future, thanks for adding the tags for me!

 

[Snakehips]

@gberg Apologies if I am not interpreting this correctly.

You would appear to be coding both a loop by row and a Find function but with neither doing the job?
Not sure what the loop for I is looking to achieve.
As you insert rows lastRow will be outdated.
Within your loop you are always setting ing to the first find of SUBCONTRACT.
Also, should be no need to do any selecting of cells?


See if the code below helps, either fully or in part.

Sub Ttl_Row()

Dim ws As Worksheet
Dim fRow As Long
Dim ing As Range

' Set the worksheet where your data is located
Set ws = ThisWorkbook.Sheets("Job Cost Analysis Report")


'Find first instance of SUBCONTRACT
Set ing = Sheets("Job Cost Analysis Report").Range("TBL_JCAR[Description]").Find("SUBCONTRACT", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
'Note the row number of the first find
If Not ing Is Nothing Then fRow = ing.Row
Application.ScreenUpdating = False
Do While Not ing Is Nothing      'loop until ing is nothing

    'Insert Total Row
    ing.Offset(2, 0).EntireRow.Insert
    ing.Offset(2, 0) = "TOTAL"
    'find next instance of SUBCONTRACT
    Set ing = Cells.FindNext(After:=ing)
    'check if it isback to finding the first and if so set ing to nothing
    If ing.Row = fRow Then Set ing = Nothing
Loop
Application.ScreenUpdating = True
End Sub

 

[gberg]

You interpreted it perfectly! That did the trick and got me exactly what I wanted. Thanks for your help!