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

"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

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

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

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

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

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

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

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