Janelle Koh Hui Juan
Janelle Koh Hui Juan

Reputation: 91

VBA matching and mismatch

I need help with comparing. I have to compare sheet 1 and sheet 2 : two column.

If both of the column matches in both sheet 1 and 2 then it will display to sheet3 , showing the match and mismatch.

Sheet 1:

Column 1: ID 123 132 1234
Column 2: Amount 100 45 50         

Sheet2:

Column 1: ID 123 132 1234
Column 2: Amount 0 45 50        

My display on sheet3 should display: Match:

ID 132                        Amount 45
ID 1234                       Amount 50

Mismatch:

ID 
123

Here is my code:

Sub FindMatches()

    Dim Sht1Rng As Range
    Dim Sht2Rng As Range
    Dim C As Range
    Dim D As Range


    With Worksheets("Sheet1")
        Set Sht1Rng = .Range("B1", .Range("B65536").End(xlUp))
        Set Sht1Rng = .Range("D1", .Range("B65536").End(xlUp))
    End With

    With Worksheets("Sheet2")
        Set Sht2Rng = .Range("H1", .Range("H65536").End(xlUp))
        Set Sht2Rng = .Range("L1", .Range("B65536").End(xlUp))
    End With


    For Each C In Sht1Rng
        If Not IsError(Application.Match(C.Value, Sht2Rng, 0)) Then ' <-- successful match in both columns
            Worksheets("Match").Range("A65536").End(xlUp).Offset(1, 0).Value = C.Value
            Worksheets("Match").Range("A65536").End(xlUp).Offset(0, 1).Value = C.Offset(0, 2).Value
        End If


    Next C

End Sub

Upvotes: 2

Views: 95

Answers (2)

AlwaysData
AlwaysData

Reputation: 555

See if this is what you are looking for. I didn't fully test this, I only ran one scenario through it. I rewrote what you had before.

Option Explicit

Sub FindMatches()

    Dim Ws1 As Worksheet
    Set Ws1 = ActiveWorkbook.Worksheets("Sheet1")

    Dim Ws2 As Worksheet
    Set Ws2 = ActiveWorkbook.Worksheets("Sheet2")

    Dim Ws3 As Worksheet
    Set Ws3 = ActiveWorkbook.Worksheets("Sheet3")

    Dim ws2_last_row As Long
    ws2_last_row = Ws2.Range("A" & Ws2.Rows.Count).End(xlUp).Row
    Dim ws3_insert_row As Long
    ws3_insert_row = Ws3.Range("A" & Ws3.Rows.Count).End(xlUp).Row + 1
    Dim cl As Range
    For Each cl In Ws1.Range("A2:A" & Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row)

        Dim find_rng As Range
        Set find_rng = Ws2.Range("A2:A" & ws2_last_row).Find(cl.Value)

        If Not find_rng Is Nothing Then
            If find_rng.Offset(0, 1).Value = cl.Offset(0, 1).Value Then
                Ws3.Range("A" & ws3_insert_row).Value = cl.Value
                Ws3.Range("B" & ws3_insert_row).Value = cl.Offset(0, 1).Value
                ws3_insert_row = ws3_insert_row + 1
            End If
        End If


    Next cl

End Sub

Sheet3 looks like this after the procedure runs.

enter image description here

Upvotes: 1

user4039065
user4039065

Reputation:

You have forgotten that there is a horizontal HLOOKUP to compliment the (much more frequently used) vertical VLOOKUP.

In H8 (as per the accompanying imnage),

=HLOOKUP(H7, 1:2, 2, FALSE)

Fill right.

enter image description here

Upvotes: 1

Related Questions