the following code should keep looking until FirstValue does not equal SecondValue or until the cell in column A of sheet2 is empty.
It isn't working. I'm a bit of a novice and the book I have is not helping to any great extent.
Anything you can suggest is greatly appreciated.
Sub ProductServiceBoth()
Dim FirstValue, SecondValue As String
Dim Cel As Range
For Each Cel In Selection
Set c = Worksheets("Sheet2").Columns("A:A").Find(Worksheets("Sheet1").Range(Cel.Address).Value, LookIn:=xlWhole)
FirstValue = Worksheets("Sheet2").Range(c.Address).Offset(0, 3).Value
Set b = Worksheets("Sheet2").Columns("A:A").FindNext(c)
SecondValue = Worksheets("Sheet2").Range(b.Address).Offset(0, 3).Value
If FirstValue <> SecondValue Then
Worksheets("Sheet1").Range(Cel.Address).Offset(0, 3).Value = "Both"
Else
Do While FirstValue = SecondValue
Set b = Worksheets("Sheet2").Columns("A:A").FindNext(c)
SecondValue = Worksheets("Sheet2").Range(b.Address).Offset(0, 3).Value
If FirstValue <> SecondValue Then
Worksheets("Sheet1").Range(Cel.Address).Offset(0, 3).Value = "Both"
Else
End If
Loop
End If
Next Cel
End Sub
Thanks
It isn't working. I'm a bit of a novice and the book I have is not helping to any great extent.
Anything you can suggest is greatly appreciated.
Sub ProductServiceBoth()
Dim FirstValue, SecondValue As String
Dim Cel As Range
For Each Cel In Selection
Set c = Worksheets("Sheet2").Columns("A:A").Find(Worksheets("Sheet1").Range(Cel.Address).Value, LookIn:=xlWhole)
FirstValue = Worksheets("Sheet2").Range(c.Address).Offset(0, 3).Value
Set b = Worksheets("Sheet2").Columns("A:A").FindNext(c)
SecondValue = Worksheets("Sheet2").Range(b.Address).Offset(0, 3).Value
If FirstValue <> SecondValue Then
Worksheets("Sheet1").Range(Cel.Address).Offset(0, 3).Value = "Both"
Else
Do While FirstValue = SecondValue
Set b = Worksheets("Sheet2").Columns("A:A").FindNext(c)
SecondValue = Worksheets("Sheet2").Range(b.Address).Offset(0, 3).Value
If FirstValue <> SecondValue Then
Worksheets("Sheet1").Range(Cel.Address).Offset(0, 3).Value = "Both"
Else
End If
Loop
End If
Next Cel
End Sub
Thanks