Inserting rows

[Rex Dunlap]

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

 

[Brad]

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

 

[Roger Whitehead]

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

 

[Rex]

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

 

[Robert McCurdy]

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