Change value of the cell below based on criteria

[Loss1003]

I'm attempting to write code to change the value of the cell below when the cell above matches "Amount X's of" in column G. However the range can expand or collapse based on the amount of rows the user enters.

Dim FoundCell As Range
Set FoundCell = Range("G2:G100").Find(What:="Amount X's of")
Do Until FoundCell Is Nothing
ActiveCell.Offset(1, 0).Value = "25"
Set FoundCell = Range("G2:G100").FindNext
Loop

Amount of X's of
1111 (change this)
1111 (do not change)
1111 (do not change)
Amount of X's of
0000 (change this)
1111 (do not change)
1111 (do not change)

[Bob Phillips]

[vba]


Dim FoundCell As Range
Dim lastrow As Long

With ActiveSheet

lastrow = .Cells(.Rows.Count, "G").End(xlUp).Row
With Range("G2:G" & lastrow)

Set FoundCell = .Find(What:="Amount X's of")
Do Until FoundCell Is Nothing
FoundCell.Offset(1, 0).Value = "25"
Set FoundCell = .FindNext(FoundCell)
Loop
End With
End With
[/vba]