Do Loop Won't Stop Looping

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I am using the following code to find "0"in Column R, then select three cells
to the left and clear the contents in those cells. This code performs the
operation, however, it gets stuck in the loop...Can anyone help.

Thanks

Do Until ActiveCell.Value = "END"
Columns("R:R").Select
Selection.Find(What:="0", After:=ActiveCell, LookIn:=xlFormulas,
LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(0, -3).Range("A1:D1").Select
Selection.ClearContents
Loop
 
Try:


With Columns("R:R")
Set c = .Find(What:="0", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Offset(0, -3).Resize(1, 3).ClearContents
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
 
Your active cell is going to move around on you and neve find the "END" cell.
Try this...

Sub DoStuff()
Dim rngSearch As Range
Dim rngFound As Range
Dim rngFoundAll As Range
Dim strFirstAddress As String
Dim wks As Worksheet

Set wks = ActiveSheet
Set rngSearch = wks.Columns("R")
Set rngFound = rngSearch.Find(What:="0", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
Set rngFoundAll = rngFound
Do
Set rngFoundAll = Union(rngFoundAll, rngFound)
rngSearch.FindNext (rngFound)
Loop Until rngFound.Address = strFirstAddress
rngFoundAll.Offset(0, 3).ClearContents
End If
End Sub
 
Sorry lost my connection and posted bad code... Give this a try...

Sub DoStuff()
Dim rngSearch As Range
Dim rngFound As Range
Dim rngFoundAll As Range
Dim strFirstAddress As String
Dim wks As Worksheet

Set wks = ActiveSheet
Set rngSearch = wks.Columns("R")
Set rngFound = rngSearch.Find(What:="0", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
Set rngFoundAll = rngFound
Do
Set rngFoundAll = Union(rngFoundAll, rngFound)
Set rngFound = rngSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
rngFoundAll.Offset(0, 3).ClearContents
End If
End Sub
 
And I read the question wrong... This is just not my thread...

Sub DoStuff()
Dim rngSearch As Range
Dim rngFound As Range
Dim rngFoundAll As Range
Dim strFirstAddress As String
Dim wks As Worksheet

Set wks = ActiveSheet
Set rngSearch = wks.Columns("R")
Set rngFound = rngSearch.Find(What:="0", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
Set rngFoundAll = rngFound
Do
Set rngFoundAll = Union(rngFoundAll, rngFound)
Set rngFound = rngSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
rngFoundAll.Offset(0, -3).Resize(1, 3).ClearContents
End If
End Sub
 
Nice to see someone read the question correctly. My only thoughts on that
code would be to set the calculation setting as your changes may be causing a
recalc with each iteration

on error goto errorhandler
application.calculation = xlManual
With Columns("R:R")
Set c = .Find(What:="0", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Offset(0, -3).Resize(1, 3).ClearContents
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

ErrorHandler:
application.calculation = xlAutomatic
end sub
 
Thanks for the responses. I have tried this and it does not do anything to
my spread sheet. The Do Loop I had would actuall do the task I wanted, but
it would get stuck in the loop. Alls the suggesed code you have given me do
not even complete the task once.

Thanks,

Lost
 
Thank you for your qick response. This code does not do anything to the data
at all. I think it may be bacause there are intermittent blank cells between
the top and bottom of the data in Column R. That is why I was trying to end
the loop by placing "END" in the cell below the last entry of data in Column
R.

Thanks

Lost
 
The resize was not working for some reason... Try this...

Sub DoStuff()
Dim rngSearch As Range
Dim rngFound As Range
Dim rngFoundAll As Range
Dim strFirstAddress As String
Dim wks As Worksheet

Set wks = ActiveSheet
Set rngSearch = wks.Columns("R")
Set rngFound = rngSearch.Find(What:="0", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
Set rngFoundAll = rngFound
Do
Set rngFoundAll = Union(rngFoundAll, rngFound)
Set rngFound = rngSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
wks.Range(rngFoundAll.Offset(0, -3), rngFoundAll.offset(0,
-1)).ClearContents
End If
End Sub
 
Jim,

I reran this and it works for the first occurence only. I think it is
because there are intermittent blank cells in Column R. That is why I was
trying to place "END" in the cell below the last cell of data in R to stop
the loop instead of using a Blank Cell.

Thanks,
 
My mind has not been exactly with me today (still isn't but I shall forege
bravely on)
One thing to note is your code that was originally posted is looking for
text zero not numeric zero, which is the same in my code. I assume this to be
correct.

Sub DoStuff()
Dim rngSearch As Range
Dim rngFound As Range
Dim rngFoundAll As Range
Dim strFirstAddress As String
Dim wks As Worksheet

Set wks = ActiveSheet
Set rngSearch = wks.Columns("R")
Set rngFound = rngSearch.Find(What:="0", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False) ', _
'SearchFormat:=False)

If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
Set rngFoundAll = rngFound
Do
Set rngFoundAll = Union(rngFoundAll, rngFound)
Set rngFound = rngSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
Set rngFoundAll = Union(rngFoundAll.Offset(0, -3), _
rngFoundAll.Offset(0, -2), _
rngFoundAll.Offset(0, -1))
rngFoundAll.ClearContents
End If
End Sub
 
Back
Top