none
How to go through a list on two different worksheets comparing values using VBA RRS feed

  • Question

  • Thanks in advance for everyone's help

    I am trying to match 2 columns in one worksheet with 2 (or potentially more) columns in another worksheet. I have attached my excel which hopefully gives a good description of what I have been trying to do for the past week. I think I am on the right track but I don't know how to properly reference between the two worksheets. I'll try to answer question to my best.

    Thanks!

    What I would like to do is look at Location 1, then see if that location references with my RefSheet in either location 1 or location 2 If it does I want to see if Location 2 then matches up in the somewhere in the same row on the RefSheet If there is a match I want to highlight the cell/cells yellow and give the ID number from RefSheet If there is no match I want to either highlight it red or no highlight

    Sheet All
    A       B               C               D
    ID  Location
    1  Location 2  Given ID
    1   West    North  
    2   North   South  
    3   South   East    
    4   East    West    
    5   East    East    
    6   South   West




    Sheet RefSheet
    A       B               C  
    ID  Location
    1     Location 2
    1   West            North
    2   West            East
    3   South           East
    4   South           North




    What it should look
    like on the original Worksheet
    A               B               C           D
    ID          Location
    1  Location 2      Given ID
    1(Yellow)   West            North           1
    2(Yellow)   North           South           4
    3(Yellow)   South           East            3
    4(Yellow)   East            West            2
    5(Red)      East            East    
    6(Red)      South           West    

    Here is my terrible Code Sub roadfinder()

    Dim lngLast As Long
    Dim lngCounter As Long
    Dim rCell As Range
    Dim lCnt As Long
    Dim nextIntersection
    Dim RefSheet As Worksheet
    Dim list As Worksheet

    Set intersections = ThisWorkbook.Sheets("RefSheet")
    Set crashes = ThisWorkbook.Sheets("All")


    Application
    .ScreenUpdating = False
    lngLast
    = Cells(Rows.Count, "B").End(xlUp).Row
    For lngCounter = 2 To lngLast
       
    With Cells(lngCounter, "B")

           
    For Each rCell In RefSheet.Range("B1", RefSheet.Cells(RefSheet.Rows.Count, 1)).Cells
            lCnt
    = lCnt + 1

               
    'I wasn't sure what to put as a reference to
               
    If .Value = "" Then
                   
    .Interior.ColorIndex = 6

               
    End If

           
    Next rCell
       
    End With
    Next lngCounter

    Application
    .ScreenUpdating = True


    Thursday, June 7, 2012 6:52 PM

Answers

  • Try this macro. The first sheet (the one to be colored) should be the active sheet when you run the macro.

    Sub CompareLists()
        Dim wsh1 As Worksheet
        Dim wsh2 As Worksheet
        Dim r As Long
        Dim m As Long
        Dim s As Long
        Dim n As Long
        Set wsh1 = ActiveSheet
        m = wsh1.Range("A" & wsh1.Rows.Count).End(xlUp).Row
        wsh1.Range("A2:A" & m).Interior.Color = vbRed
        Set wsh2 = Worksheets("RefSheet")
        n = wsh2.Range("A" & wsh2.Rows.Count).End(xlUp).Row
        For r = 2 To m
            For s = 2 To n
                If wsh1.Range("B" & r) = wsh2.Range("B" & s) And _
                   wsh1.Range("C" & r) = wsh2.Range("C" & s) Or _
                   wsh1.Range("B" & r) = wsh2.Range("C" & s) And _
                   wsh1.Range("C" & r) = wsh2.Range("B" & s) Then
                    wsh1.Range("A" & r).Interior.Color = vbYellow
                    wsh1.Range("D" & r) = wsh2.Range("A" & s)
                    Exit For
                End If
            Next s
        Next r
    End Sub
    


    Regards, Hans Vogelaar

    • Marked as answer by Bhova Monday, June 25, 2012 1:13 PM
    Thursday, June 7, 2012 7:21 PM

All replies

  • Try this macro. The first sheet (the one to be colored) should be the active sheet when you run the macro.

    Sub CompareLists()
        Dim wsh1 As Worksheet
        Dim wsh2 As Worksheet
        Dim r As Long
        Dim m As Long
        Dim s As Long
        Dim n As Long
        Set wsh1 = ActiveSheet
        m = wsh1.Range("A" & wsh1.Rows.Count).End(xlUp).Row
        wsh1.Range("A2:A" & m).Interior.Color = vbRed
        Set wsh2 = Worksheets("RefSheet")
        n = wsh2.Range("A" & wsh2.Rows.Count).End(xlUp).Row
        For r = 2 To m
            For s = 2 To n
                If wsh1.Range("B" & r) = wsh2.Range("B" & s) And _
                   wsh1.Range("C" & r) = wsh2.Range("C" & s) Or _
                   wsh1.Range("B" & r) = wsh2.Range("C" & s) And _
                   wsh1.Range("C" & r) = wsh2.Range("B" & s) Then
                    wsh1.Range("A" & r).Interior.Color = vbYellow
                    wsh1.Range("D" & r) = wsh2.Range("A" & s)
                    Exit For
                End If
            Next s
        Next r
    End Sub
    


    Regards, Hans Vogelaar

    • Marked as answer by Bhova Monday, June 25, 2012 1:13 PM
    Thursday, June 7, 2012 7:21 PM
  • Thank you! I am testing it now
    • Marked as answer by Bhova Thursday, June 7, 2012 7:52 PM
    • Unmarked as answer by Bhova Thursday, June 7, 2012 9:04 PM
    Thursday, June 7, 2012 7:44 PM
  • Thanks for all the help. I tested your code a couple times. It took over 8 hours each time to test! Ha there's a lot of data. I'm not 100% it works but it looks promising. I'll keep you posted. 

    I did have one more question: 

    If wsh1.Range("B" & r) = wsh2.Range("B" & s) And _
                   wsh1.Range("C" & r) = wsh2.Range("C" & s) Or _
                   wsh1.Range("B" & r) = wsh2.Range("C" & s) And _
                   wsh1.Range("C" & r) = wsh2.Range("B" & s) 

    I can put as many Or statements in that clause as I want and it should be fine correct?

    Thanks

    Hova

    Monday, June 11, 2012 1:19 PM
  • Yes, you can add more Or statements - but the code will become even slower!

    Regards, Hans Vogelaar

    Thursday, June 14, 2012 12:09 AM