Conditional Macro

Adrae

Active Member
Joined
Feb 19, 2002
Messages
306
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?
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
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"
 
Upvote 0
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.
 
Upvote 0
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 :)
 
Upvote 0
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
 
Upvote 0
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)
 
Upvote 0
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 :)
 
Upvote 0
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?
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

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