Conditional Macro

[Adrae]

I need a macro or formula that will do the following:

1. If the value in Sheet1 cell A1 is found in cells in column A of Sheet2 where the value in column D is product in one cell and service in another then Sheet1 cell f1 = "Both".

2. If the value in Sheet1 cell A1 is found in column A of sheet two and the corresponing values in column D are only product then f1 = "Product.

The trick is that the value that is being search will appear more than once on Sheet 2. If different values are found in column D for the same value in column A then, the condition in #1 should apply.


I hope this all makes sense.
Can anyone get me started?

[Al Chara]

Try the following:

Dim FirstValue, SecondValue As String
On Error GoTo 1
Set c = Worksheets("Sheet2").Columns("A").Find(Worksheets("Sheet1").Range("a1").Value, LookIn:=xlWhole)
FirstValue = Worksheets("Sheet2").Range(c.Address).Offset(0, 3).Value
Set c = Worksheets("Sheet2").Columns("A").FindNext(c)
SecondValue = Worksheets("Sheet2").Range(c.Address).Offset(0, 3).Value
If FirstValue = SecondValue Then
Worksheets("Sheet1").Range("F1").Value = "Both"
Else: Worksheets("Sheet1").Range("F1").Value = "Product"
End If
Exit Sub
1 MsgBox "Value not found"

[Anne Troy]

You don't need code to produce these results. Check out the MyVlookup file at:

http://www.thewordexpert.com/tipwarez.htm#MyVlookup

[Russell Hauf]

Actually, I think code is necessary in this case due to the multiple matching values in the second sheet.

Also, can there be more than 2 values? It sounded like there could be more than 2 "matches" for a given value.

[Adrae]

Thanks - This code will certainly get me going.

How can I make it into a For-Next statement. So instead of saying, A1 of Sheet 1, I would say For Each Cell in Selection.

Also, what if the value in column A on Sheet 2 is repeated more than two times. For example, if the first occurence is equal to the second but not equal to the third or fourth, etc. Then the value will be ...

Is VBA capable of a lookup this complex?

Thanks Again

[Adrae]

OK - I tried to modify this with a For-Next statement, but it isn't working. I get the error msg box at the end. Can anyone tell me what I am doing wrong:

Sub ProductServiceBoth()
Dim FirstValue, SecondValue As String
Dim Cel As Range
On Error GoTo 1
For Each Cel In Selection
Set c = Worksheets("Sheet2").Columns("A:A").Find(Worksheets("Sheet1").Range(Cel).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 = "Product"
Else: Worksheets("Sheet1").Range(Cel.Address).Offset(0, 3).Value = "Both"
End If
Next Cel
Exit Sub
1 MsgBox "Value not found"
End Sub


[ This Message was edited by: Adrae on 2002-04-04 11:15 ]

[Al Chara]

Set c = Worksheets("Sheet2").Columns("A:A").Find(Worksheets("Sheet1").Range(Cel).Value, LookIn:=xlWhole)

This should read as follows:
Set c = Worksheets("Sheet2").Columns("A:A").Find(Worksheets("Sheet1").Range(Cel.address).Value, LookIn:=xlWhole)

[Adrae]

Thanks Al. It works now.

I have one last issue to solve. As this code is, it only looks at the first two occurrences. I want it to continue looking if the values are the same to make sure no others that are different occur. If the first two or any values after that are different from the first, then the value can be assigned immediately, no need to look further. If they are are equal, I want it to continue looking until the end of the used cell in the column. How can I tell it to keep looking if the values are the same?

Thanks again

[Adrae]

Perhaps a Do While Loop? I've been trying to code this but must be missing something. Either it seems not to run at all or runs interminably. Would a loop of this sort work to solve my final issue and if so, how would I insert the code into my existing code?

[Al Chara]

Try the following:

Dim FirstValue, SecondValue, LastAddress As String
Dim Cel As Range
Dim counter As Integer
Dim c As Object
On Error GoTo 2
LastAddress = "$A$" & WorksheetFunction.CountA(Worksheets("Sheet2").Columns(1)) + 1
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)
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
End If
Loop Until c.Address = LastAddress Or c.Address = "$A$2"
Worksheets("Sheet1").Range(Cel.Address).Offset(0, 3).Value = "Product"
1 End If
counter = counter + 1
Next Cel
Exit Sub
2 MsgBox "Value not found"

Its not that clean, but I didn't feel like rewriting everything. It should work as long as your data starts in cell A2.