Thank you very much for your help. It works without a
hitch.

-----Original Message-----
You need to work upwards from the end. Otherwise each
time you insert three
rows, the range just keeps expanding......

Dim r As Long
'Dim DataRng As Range
'Dim Cell As Range
'Set DataRng = Range("G1:G2000")
For r = 200 To 1 Step -1 'Each Cell In DataRng
'If cell value has the word 'total' in it and one row
'below current cell is blank then do something
If (InStr(LCase(Cells(r, 7)), "total") 0 And Len(Trim
(Cells(r + 1, 7)))
0) Then
Rows(r & ":" & r + 2).Insert

End If
Next r

--
HTH
Roger
Shaftesbury (UK)















"Rex Dunlap" wrote
in message
...
I have the following code that someone can gave me.
What I
am interested in is in Col G if the word 'total' appears
and the cell below is NOT blank then insert three rows.

There are 21 occurrences where the word 'total' appears
and there is not a space below. What I get is 63 rows
inserted at the top!!

I hope this is not too hard to fix. Please help me with
the fix. Thanks.

Dim DataRng As Range
Dim Cell As Range
Set DataRng = Range("G1:G2000")
For Each Cell In DataRng
'If cell value has the word 'total' in it and one row
below current cell is blank then do something
If (InStr(LCase(Cell.Value), "total") 0 And Len(Trim
(Cell.Offset(1, 0).Value)) 0) Then
Selection.EntireRow.Insert
Selection.EntireRow.Insert
Selection.EntireRow.Insert

End If
Next


.