I am trying to write VBA code to automate a monthly report. The below problem is one small part in a much larger macro automating many processes in the report. I need to find the subtotal for every sub program (SUB_PGM in column B). The values that need to be summed are in column H. It is important to note that there will not always be a consistent number of programs or transactions within the programs so sum ranges will never be consistent. My current VBA code works around this issue by referencing a lookup table containing the subtotaled values for the programs instead of trying to sum the rows in the desired set of data. For reference, the "Do Until ActiveCell = "'" " is because there is a ' underneath the last row with data in it. This is due to some other formatting reasons but I was using it as a stopping point in the loop.
While my current macro does successfully run and create these subtotals, it comes with the following error after running "Run-time error '1004': Application-defined or object-defined error. The debugger highlights the "If IsEmpty(ActiveCell.Offset(1)) Then". This error then prevents the next macro from running and the active cell after running becomes the last possible row in an excel file (1048576).
Below you will find my current code as well as a screenshot of the desired outcome. Thank you for your help!
Range("H4").Select
Selection.End(xlDown).Offset(1).Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP('Current Subpgm'!R[-1]C[-6],Table3,2,FALSE), "" "")"
Do Until ActiveCell = "'"
Selection.End(xlDown).Select
If IsEmpty(ActiveCell.Offset(1)) Then
ActiveCell.Offset(1).Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP('Current Subpgm'!R[-1]C[-6],Table3,2,FALSE), "" "")"
Else
Selection.End(xlDown).Offset(1).Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP('Current Subpgm'!R[-1]C[-6],Table3,2,FALSE), "" "")"
End If
Loop