struggling with row inserts in a macro...

[UKPhil]

Hi what Im trying to do (with no success whatsoever) is execute a macro which will
loop down a column of data until it reaches a cells with the value "Break" in them- insert a new blank row directly above the row "Break" then continue to the bottom of the list. Help!!

 

[manney]

There are several ways of looping. This one (While...wend) assumes you do not know how long your column of data is, and assumes the cells under the data are blank (Zero length)

Sub BreakFindLoop()

ROffset = 0
'Test for length of cells in column. Will not equal 0 if it contains data
While Len(Range("A1").Offset(ROffset, 0)) <> 0
'Test for word "Break"
If Range("A1").Offset(ROffset, 0) = "Break" Then
'Insert new row
Range("A1").Offset(ROffset, 0).EntireRow.Insert
'Move down so we aren't over new, blank cell
ROffset = ROffset + 1
End If
'Goto next line
ROffset = ROffset + 1
Wend

End Sub

 

[UKPhil]

Thanks Manney, but I've already got my loop working fine, the problem I have is with the actual code that will insert a blank row directly above the current ActiveCell. Anyone?

 

[NateO]

Howdy Phil, the following should shif cells with the value "break" in the active column down.

<pre>
Sub InsrtRw()
Dim c As Range, fst As Range, c2 As Range
On Error GoTo errHnd
Set c = ActiveCell.EntireColumn.Find("Break", MatchCase:=False, _
lookat:=xlPart, LookIn:=xlValues)
If Not c Is Nothing Then
c.EntireRow.Resize(1).Insert
Set fst = c
again:
Set c2 = c.EntireColumn.FindNext(c)
If Not c2 Is Nothing Then
If c2.Address <> c.Address _
And c2.Address <> fst.Address Then
c2.EntireRow.Resize(1).Insert
Set c = c2
GoTo again
End If
End If
End If
Exit Sub
errHnd: MsgBox "You've tried to shift data off the worksheet," _
& " please reconsider your worksheets layout."
End Sub</pre>

Different kind of loop... Hope this helps.

 

[NateO]

Phil, if you want the row above shifted down as well, use an index:

<pre>
Sub InsrtRw2()
Dim c As Range, fst As Range, c2 As Range
On Error GoTo errHnd
Set c = ActiveCell.EntireColumn.Find("Break", MatchCase:=False, _
lookat:=xlPart, LookIn:=xlValues)
If Not c Is Nothing Then
c(0).EntireRow.Resize(1).Insert
Set fst = c
again:
Set c2 = c.EntireColumn.FindNext(c)
If Not c2 Is Nothing Then
If c2.Address <> c.Address _
And c2.Address <> fst.Address Then
c2(0).EntireRow.Resize(1).Insert
Set c = c2
GoTo again
End If
End If
End If
Exit Sub
errHnd: MsgBox "You've tried to shift data off the worksheet," _
& " please reconsider your worksheets layout."
End Sub</pre>