Loop Until Question

[Adrae]

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

[Al Chara]

Create a new variable called PrevC. Set that equal to the c value. Then do your loop until PrevC<>c

[Adrae]

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 ]

[Al Chara]

Can you email me a copy of your workbook?

awchara@aol.com

[Al Chara]

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!")