Insert row base on specific text and its occurrence - vba

Question

I am using a VBA code to insert rows below based on a specific text and its occurrence .
I am using the following code to do so
Sub try()
Dim c As Range
For Each c In Range("A1:A100")
If c.Value Like "*COLLECTION*" Then
c.Offset(1, 0).EntireRow.Insert
End If
Next c
End Sub
I want to have the text BALANCE below the COLLECTION cell instead of blank row.
I want to insert the BALANCE row below the last COLLECTION entry, for example if there are two collections rows serially then I want to add the BALANCE row after the 2nd collection row. but with the above VBA code I am getting blank rows below to the each collection row.
My Collection and balance rows are in the column A
Before macro Image kindly check
After macro I want like this Image kindly check

Answer 1

I would do this using a loop from row 1 till last filled row in column A. Then having a boolean marker which is true while the cell value in current cell is like "*COLLECTION*" but false while not. So if the current cell is not like "*COLLECTION*" but the marker is true then the last cell above the current cell was like "*COLLECTION*". Then insert a new row with "BALANCE" if that cell is not already "BALANCE".
Sub try()
Dim c As Range
Dim lRow As Long
lRow = 1
Dim lRowLast As Long
Dim bFound As Boolean
With ActiveSheet
lRowLast = .Cells(.Rows.Count, 1).End(xlUp).Row
Do
Set c = .Range("A" & lRow)
If c.Value Like "*COLLECTION*" Then
bFound = True
ElseIf bFound Then
bFound = False
If c.Value <> "BALANCE" Then
c.EntireRow.Insert
lRowLast = lRowLast + 1
c.Offset(-1, 0).Value = "BALANCE"
c.Offset(-1, 0).Font.Color = RGB(0, 0, 0)
End If
End If
lRow = lRow + 1
Loop While lRow <= lRowLast + 1
End With
End Sub

Answer 2

That's typically the kind of cases you want to start from the last cell, because inserting a row will mess up all counters from what is below.
In other words, the elegant for each is not really a good idea. Too unpredictable. An ugly, old simple For Step -1 is the way to go. Something like :
Sub Macro1()
For l = 100 To 1 Step -1
If Trim(Cells(l, 1)) = "COLLECTION" And Trim(Cells(l + 1, 1)) = "DEMAND" Then
Rows(CStr(l + 1) & ":" & CStr(l + 1)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(l + 1, 1) = "BALANCE"
End If
Next l
End Sub
Just tried on EXCEL 2013, seems to work as you want. There may be more elegant solutions, though.
EDIT : the idea is the following one :
_Begin by the last line(in fact, the last line cannot work, so one optimization could be to start from the prevo=ious one), and go to the first one
_If the line testes is "COLLECTION", and the next one is "DEMAND", then you need to insert a "BALANCE" line in between. It's done in 2 times, first insert an empty line, then add "BALANCE" in the newly created line.