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

You shouldn't use the Selection object unless you are
using the Select method on every iteration of the For Each
structure.



Dim DataRng As Range
Dim Cell As Range
Set DataRng = Range("G1:G2000")
Dim i As Integer
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 Not
IsEmpty(Trim(Cell.Offset(1, 0).Value)) Then
For i = 1 To 3
Cell.Offset(1, 0).EntireRow.Insert
Next

End If
Next

HTH.

-Brad

-----Original 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
.

Hi Brad.
I just noticed this before I posted a possible solution

I am interested in is in Col G if the word 'total' appears
and the cell below is NOT blank then insert three rows.

This is a little confusion as you also left this in the code you posted.
If cell value has the word 'total' in it and one row
'below current cell is blank then do something.
That is a contradiction with your request.

So I'm going with the first one.
This is very fast.


Sub InsertaRows()
Dim c As Range, x As Long
Application.ScreenUpdating = False
With ActiveSheet.Range("G:G")
Set c = .Find("Total", LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
x = c.Row
Do
If c.Offset(1, 0).Value < "" Then _
c.Offset(1, 0).Resize(3, 1).EntireRow.Insert
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Row x
End If
End With
End Sub


Regards Robert

"Brad" wrote in message ...
You shouldn't use the Selection object unless you are
using the Select method on every iteration of the For Each
structure.



Dim DataRng As Range
Dim Cell As Range
Set DataRng = Range("G1:G2000")
Dim i As Integer
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 Not
IsEmpty(Trim(Cell.Offset(1, 0).Value)) Then
For i = 1 To 3
Cell.Offset(1, 0).EntireRow.Insert
Next

End If
Next

HTH.

-Brad

-----Original 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
.



---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.593 / Virus Database: 376 - Release Date: 21/02/2004

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

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


.