Do Loop Won't Stop Looping
 

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

Do Loop Won't Stop Looping
 

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

"Lost in Alabama" wrote:

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

Do Loop Won't Stop Looping
 

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

--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

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

Do Loop Won't Stop Looping
 

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

--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

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

Do Loop Won't Stop Looping
 

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

--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

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

Do Loop Won't Stop Looping
 

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
--
HTH...

Jim Thomlinson


"Toppers" wrote:

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

"Lost in Alabama" wrote:

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

Do Loop Won't Stop Looping
 

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


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

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

Do Loop Won't Stop Looping
 

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


"Toppers" wrote:

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

"Lost in Alabama" wrote:

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

Do Loop Won't Stop Looping
 

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

--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

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


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

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

Do Loop Won't Stop Looping
 

Jim,

I tried this and It will not go past

Set rngFound = rngSearch.FindNext(rngFound)

Thanks,



"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

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


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

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

Do Loop Won't Stop Looping
 

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,



"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

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


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

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

Do Loop Won't Stop Looping
 

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
--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

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,



"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

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


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

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

Do Loop Won't Stop Looping
 

Thank you so much, Jim. This works perfectly. You are GREAT!

Lost

"Jim Thomlinson" wrote:

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
--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

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,



"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

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


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

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

Do Loop Won't Stop Looping
 

More persistent than great... If at first you don't succeed...
--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

Thank you so much, Jim. This works perfectly. You are GREAT!

Lost

"Jim Thomlinson" wrote:

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
--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

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,



"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

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


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

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

--
HTH...

Jim Thomlinson


"Lost in Alabama" wrote:

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