Loop Does Not Stop

  • Thread starter Thread starter pwk
  • Start date Start date
P

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
 
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)
 
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)
Click to expand...

With your code (untested) I get a compile error;: Loop without Do.
Anymore help would be appreciated..
 
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
 
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
Click to expand...

Thanks Don, Worked like a charm.
 
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)
 
Back
Top