Hi,

I am trying to insert 2 rows above and below the rows where column B
ends with the word "Total". But when I insert the first set of rows,
that first group footer is shifted down, so the macro finds it again,
and inserts 2 more rows around it!

I didn't think I could redefine the range inside the loop, but it came
closer to working than I expected, but it's still not working. If
that's the right idea, I'm not quite there. And it's entirely possible
I'm just going at it the wrong way.

I'm going to get protein, and see if moving around gains me some
clarity but, in the meanwhile, if anyone cares to toss it out off their
top of their head, that would be lovely too!

LastRow = Range("B1").SpecialCells(xlLastCell).Row
Range(Range("B11"), Cells(LastRow, 2)).Select

For Each Cell In Selection
If InStr(Cell.Value, "Total") Then
Cell.EntireRow.Insert
Cell.EntireRow.Insert
Cell.Offset(1, 0).EntireRow.Insert
Cell.Offset(1, 0).EntireRow.Insert

NewStart = Cell.Row

'Reset Selection?
Range(Cells(NewStart + 1, 2), Cells(LastRow, 2)).Select

End If
Next Cell

Well, looking at it again, before sending, it occurs to me that I
probably need to end the loop on find, and start over below. So, an
outer/inner loop situation? Seems like overkill, but perhaps....

Thanks!
NJ

I found an elegant solution in another article. Moving upward thru the
range.

For i = LastRow To 2 Step -1
If InStr(Cells(i, 2), "Total") Then
Rows(i).Insert
End If
Next

nj wrote:
Hi,

I am trying to insert 2 rows above and below the rows where column B
ends with the word "Total". But when I insert the first set of rows,
that first group footer is shifted down, so the macro finds it again,
and inserts 2 more rows around it!


LastRow = Range("B1").SpecialCells(xlLastCell).Row
Range(Range("B11"), Cells(LastRow, 2)).Select

For Each Cell In Selection
If InStr(Cell.Value, "Total") Then
Cell.EntireRow.Insert
Cell.EntireRow.Insert
Cell.Offset(1, 0).EntireRow.Insert
Cell.Offset(1, 0).EntireRow.Insert

NewStart = Cell.Row

'Reset Selection?
Range(Cells(NewStart + 1, 2), Cells(LastRow, 2)).Select

End If
Next Cell

Sub aBC()
Dim lastrow As Long
Dim i As Long
Dim cell As Range
lastrow = Range("B1").SpecialCells(xlLastCell).Row

i = lastrow
Do While i 11
Set cell = Cells(i, 2)
If InStr(cell.Value, "Total") Then
cell.EntireRow.Insert
cell.EntireRow.Insert
cell.Offset(1, 0).EntireRow.Insert
cell.Offset(1, 0).EntireRow.Insert
i = i - 3
Else
i = i - 1
End If
Loop

End Sub

seemed to work.

--
Regards,
Tom Ogilvy


"nj" wrote:

Hi,

I am trying to insert 2 rows above and below the rows where column B
ends with the word "Total". But when I insert the first set of rows,
that first group footer is shifted down, so the macro finds it again,
and inserts 2 more rows around it!

I didn't think I could redefine the range inside the loop, but it came
closer to working than I expected, but it's still not working. If
that's the right idea, I'm not quite there. And it's entirely possible
I'm just going at it the wrong way.

I'm going to get protein, and see if moving around gains me some
clarity but, in the meanwhile, if anyone cares to toss it out off their
top of their head, that would be lovely too!

LastRow = Range("B1").SpecialCells(xlLastCell).Row
Range(Range("B11"), Cells(LastRow, 2)).Select

For Each Cell In Selection
If InStr(Cell.Value, "Total") Then
Cell.EntireRow.Insert
Cell.EntireRow.Insert
Cell.Offset(1, 0).EntireRow.Insert
Cell.Offset(1, 0).EntireRow.Insert

NewStart = Cell.Row

'Reset Selection?
Range(Cells(NewStart + 1, 2), Cells(LastRow, 2)).Select

End If
Next Cell

Well, looking at it again, before sending, it occurs to me that I
probably need to end the loop on find, and start over below. So, an
outer/inner loop situation? Seems like overkill, but perhaps....

Thanks!
NJ