Insert new row if Matching word is found

[chris186h]

Hello All.
The code below is sort of what im after, although instead of inserting a row when it finds a match i want it to insert a row if it contains the word "Total".

Dim cell As RangeFor Each cell In Range("B2", Cells(Rows.Count, "B").End(xlUp).Address)
'loop from B1 to the last used cell in column B
    If cell.Offset(-1, 0).Value2 <> cell.Value2 And cell.Offset(-1, 0) <> vbNullString Then cell.EntireRow.Insert
    'if the cell above is different and not null then it adds a row above
Next cell

Thankyou for all your help in advance

 

[BarryL]

try

Dim rng as range
For each rng in Range("B2", Cells(Rows.Count, "B").End(xlUp).Address)
If Instr(Ucase(rng.Value),"TOTAL")>0 Then rng.EntireRow.Insert Shift:=xlDown
next rng

 

[chris186h]

Thankyou for your response. However this seams to keep inserting multiple rows above the cell containing total and does not move onto the next match.

try

Dim rng as range
For each rng in Range("B2", Cells(Rows.Count, "B").End(xlUp).Address)
If Instr(Ucase(rng.Value),"TOTAL")>0 Then rng.EntireRow.Insert Shift:=xlDown
next rng