Loop Until Question

Adrae

Active Member
Joined
Feb 19, 2002
Messages
306
I have a loop set up to Loop Unitl c = "". However, there are 20,000 reocrds and its taking a long time. So I have sorted them by the "c" value.

How can I rewrite this loop to Loop Until c in different?

Here's the full macro:
Sub ProductServiceBoth()
Application.ScreenUpdating = False
Dim FirstValue, SecondValue, LastAddress, ThirdValue As String
Dim Cel As Range
Dim c As Object
For Each Cel In Selection
Set c = Worksheets("Sheet2").Columns("A:A").Find(Worksheets("Sheet1").Range(Cel.Address).Value, LookIn:=xlWhole, SearchOrder:=xlByColumns)
FirstValue = Worksheets("Sheet2").Range(c.Address).Offset(0, 3).Value
Set c = Worksheets("Sheet2").Columns("A:A").FindNext(c)
SecondValue = Worksheets("Sheet2").Range(c.Address).Offset(0, 3).Value
If FirstValue <> SecondValue Then
Worksheets("Sheet1").Range(Cel.Address).Offset(0, 3).Value = "Both"
GoTo 1
Else:
Do
Set c = Worksheets("Sheet2").Columns("A:A").FindNext(c)
ThirdValue = Worksheets("Sheet2").Range(c.Address).Offset(0, 3).Value
If FirstValue <> ThirdValue Then
Worksheets("Sheet1").Range(Cel.Address).Offset(0, 3).Value = "Both"
GoTo 1
End If
Loop Until c = ""
End If
1 Cel.Interior.ColorIndex = 6
Next Cel
Application.ScreenUpdating = True
MsgBox ("Done!")

Thanks :)
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Create a new variable called PrevC. Set that equal to the c value. Then do your loop until PrevC<>c
 
Upvote 0
Hello again Al,

I changed the end of the code as follows and am getting an "Overflow" error. The debug leads me to the following line of code:

PrevC = Worksheets("Sheet2").Range(c.Address).Value

FYI - I Dim'd CurrC & PrevC as Integers at the begining of the code.

Do
CurrC = Worksheets("Sheet2").Range(c.Address).Value
Set c = Worksheets("Sheet2").Columns("A:A").FindNext(c)
PrevC = Worksheets("Sheet2").Range(c.Address).Value
ThirdValue = Worksheets("Sheet2").Range(c.Address).Offset(0, 3).Value
If FirstValue<> ThirdValue Then
Worksheets("Sheet1").Range(Cel.Address).Offset(0, 3).Value = "Both"
GoTo 1
End If
Loop Until CurrC<> PrevC
End If
1 Cel.Interior.ColorIndex = 6
Next Cel
Application.ScreenUpdating = True
MsgBox ("Done!")
End Sub
This message was edited by Adrae on 2002-04-05 11:54
 
Upvote 0
Ok, I think I got it for you. Try the following:

Application.ScreenUpdating = False
Dim FirstValue, SecondValue, FirstAddress, CheckAddress, ThirdValue As String
Dim Cel As Range
Dim c As Object
For Each Cel In Selection
Set c = Worksheets("Sheet2").Columns("A:A").Find(Cel.Value, LookIn:=xlWhole, SearchOrder:=xlByColumns)
FirstAddress = c.Address
FirstValue = Worksheets("Sheet2").Range(c.Address).Offset(0, 3).Value
Set c = Worksheets("Sheet2").Columns("A:A").FindNext(c)
SecondValue = Worksheets("Sheet2").Range(c.Address).Offset(0, 3).Value
If FirstValue <> SecondValue Then
Cel.Offset(0, 3).Value = "Both"
GoTo 1
Else:
Do
Set c = Worksheets("Sheet2").Columns("A:A").FindNext(c)
CheckAddress = c.Address
ThirdValue = Worksheets("Sheet2").Range(c.Address).Offset(0, 3).Value
If FirstValue <> ThirdValue Then
Cel.Offset(0, 3).Value = "Both"
GoTo 1
End If
Loop Until FirstAddress = CheckAddress
End If
1 Cel.Interior.ColorIndex = 6
Next Cel
Application.ScreenUpdating = True
MsgBox ("Done!")
 
Upvote 0

Forum statistics

Threads
1,213,513
Messages
6,114,064
Members
448,545
Latest member
kj9

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top