Conditional Macro
MZ Tools makes life easier for the Excel VBA coder
Thanks Thanks:  0
Likes Likes:  0
Page 1 of 2 12 LastLast
Results 1 to 10 of 11

Thread: Conditional Macro

  1. #1
    Board Regular
    Join Date
    Feb 2002
    Location
    Chicago, IL USA
    Posts
    306
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

     
    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?

  2. #2
    MrExcel MVP Al Chara's Avatar
    Join Date
    Feb 2002
    Location
    Newark, Delaware
    Posts
    1,701
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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"
    Best regards,
    Allan Chara
    http://www.mrspreadsheets.com

  3. #3
    MrExcel MVP Anne Troy's Avatar
    Join Date
    Feb 2002
    Location
    Westwood NJ
    Posts
    2,581
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

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

    http://www.thewordexpert.com/tipwarez.htm#MyVlookup
    ~Anne Troy

  4. #4
    MrExcel MVP Russell Hauf's Avatar
    Join Date
    Feb 2002
    Location
    Portland, OR Area - USA
    Posts
    1,605
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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.

  5. #5
    Board Regular
    Join Date
    Feb 2002
    Location
    Chicago, IL USA
    Posts
    306
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  6. #6
    Board Regular
    Join Date
    Feb 2002
    Location
    Chicago, IL USA
    Posts
    306
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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 ]

  7. #7
    MrExcel MVP Al Chara's Avatar
    Join Date
    Feb 2002
    Location
    Newark, Delaware
    Posts
    1,701
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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)
    Best regards,
    Allan Chara
    http://www.mrspreadsheets.com

  8. #8
    Board Regular
    Join Date
    Feb 2002
    Location
    Chicago, IL USA
    Posts
    306
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  9. #9
    Board Regular
    Join Date
    Feb 2002
    Location
    Chicago, IL USA
    Posts
    306
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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?

  10. #10
    MrExcel MVP Al Chara's Avatar
    Join Date
    Feb 2002
    Location
    Newark, Delaware
    Posts
    1,701
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

      
    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.
    Best regards,
    Allan Chara
    http://www.mrspreadsheets.com

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

 

 
DMCA.com