Loop Does Not Stop

[pwk]

Why won't this stop looping? Where did I go wrong. It works fine but
it goes on and on.
thanks in Advance

Public Sub RowFix()

Dim c As Variant
Dim FirstRow As Integer

With Worksheets(1).Range("A6:A4000")
Set c = .Find("01152", LookIn:=xlValues)
If Not c Is Nothing Then
FirstRow = c.Row + 1
Do Until IsEmpty(ActiveCell)
c.EntireRow.Insert
c.Offset(-1, 0).Value = "Next"
Set c = .FindNext(c)
Loop
End If
End With

End Sub

 

[Patrick Molloy]

first, dim c as Range

the FIND function is circular, ie once its found the last item, it starts
again. Look up FIND in HELP and in the example they save the address of the
first find and loop until it gets back there again

Public Sub RowFix()

Dim c As Range
DIM addr as String
Dim FirstRow As Integer

With Worksheets(1).Range("A6:A4000")
Set c = .Find("01152", LookIn:=xlValues)
If Not c Is Nothing Then
FirstRow = c.Row + 1
Addr = C.Address
Do Until IsEmpty(ActiveCell)
c.EntireRow.Insert
c.Offset(-1, 0).Value = "Next"
Set c = .FindNext(c)
Loop Until c.Address = Addr
End If
End With

End Sub

(i haven't tested this)

 

[PWK]

first, dim c as Range

the FIND function is circular, ie once its found the last item, it starts
again. Look up FIND in HELP and in the example they save the address of the
first find and loop until it gets back there again

Public Sub RowFix()

Dim c As Range
DIM addr as String
Dim FirstRow As Integer

With Worksheets(1).Range("A6:A4000")
Set c = .Find("01152", LookIn:=xlValues)
If Not c Is Nothing Then
FirstRow = c.Row + 1
Addr = C.Address
Do Until IsEmpty(ActiveCell)
c.EntireRow.Insert
c.Offset(-1, 0).Value = "Next"
Set c = .FindNext(c)
Loop Until c.Address = Addr
End If
End With

End Sub

(i haven't tested this)

With your code (untested) I get a compile error;: Loop without Do.
Anymore help would be appreciated..

 

[Don Guillett]

Is this what you need?
Sub rowsinsert()
For i = Cells(Rows.Count, "a").End(xlUp).Row To 6 Step -1
If InStr(Cells(i, "a"), "01152") Then
'MsgBox i
Rows(i).Insert
Cells(i, "a") = "Next"
End If
Next i
End Sub
before
1
2
01152
1
2
01152
1
2
01152

after
1
2
Next
01152
1
2
Next
01152
1
2
Next
01152

 

[PWK]

Is this what you need?
Sub rowsinsert()
For i = Cells(Rows.Count, "a").End(xlUp).Row To 6 Step -1
If InStr(Cells(i, "a"), "01152") Then
'MsgBox i
Rows(i).Insert
Cells(i, "a") = "Next"
End If
Next i
End Sub
before
1
2
01152
1
2
01152
1
2
01152

after
1
2
Next
01152
1
2
Next
01152
1
2
Next
01152

Thanks Don, Worked like a charm.

 

[Chip Pearson]

The ActiveCell reference never changes unless you specifically change
it. Thus, in your loop, ActiveCell always points to the same cell. It
does change within the loop. In your code,


Do Until IsEmpty(ActiveCell) '<<< NEVER CHANGES
c.EntireRow.Insert
c.Offset(-1, 0).Value = "Next"
Set c = .FindNext(c)
Loop

you are changing the location to which the Range object C refers, but
you never change where ActiveCell is pointing to.


Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)




Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

 

[Patrick Molloy]

change this
Do Until IsEmpty(ActiveCell)

to just
DO