Data Matching

[daltonwkkt]

Data Matching

Download excel file : http://adf.ly/1YXNL3

Sub RoundedRectangle1_Click()

Sheet4.Cells.ClearContents
Sheet5.Cells.ClearContents

For m_column = 1 To 255

    If Sheet2.Cells(1, m_column) = "" Then
   
        Exit For
   
    End If

Next m_column



For s_column = 1 To 255

    If Sheet3.Cells(1, s_column) = "" Then
   
        Exit For
   
    End If

Next s_column



For m_row = 1 To 500000

    If Sheet2.Cells(m_row, 1) = "" Then
   
        Exit For
   
    End If
   
    For m_fill = 1 To m_column - 1
           
        Sheet4.Cells(m_row, m_fill) = Sheet2.Cells(m_row, m_fill)
           
    Next m_fill
   
    For s_row = 1 To 500000

        If Sheet3.Cells(s_row, 1) = "" Then
       
            Exit For
       
        End If
       
        If Sheet2.Cells(m_row, 1) = Sheet3.Cells(s_row, 1) Then
       
            For s_fill = 1 To s_column
           
                Sheet4.Cells(m_row, s_fill + m_column) = Sheet3.Cells(s_row, s_fill)
           

               
            Next s_fill
           
            Sheet3.Cells(s_row, s_column + 1) = "MATCHED"
               
        Else
       
            'Sheet3.Cells(s_row, s_column + 1) = "UN-MATCHED"
       
        End If
       
    Next s_row
   
    Sheet1.Cells(13, 4) = s_row - 1

Next m_row

Sheet1.Cells(12, 4) = m_row - 1

r_unmatched = 1

For fill_unmatched = 1 To 500000

    If Sheet3.Cells(fill_unmatched, 1) = "" Then
       
        Exit For
       
    End If
       
    If Sheet3.Cells(fill_unmatched, s_column + 1) = "" Then
       
        For s_column_unmatched = 1 To s_column
           
            Sheet5.Cells(r_unmatched, s_column_unmatched) = Sheet3.Cells(fill_unmatched, s_column_unmatched)
   
        Next s_column_unmatched
       
        r_unmatched = r_unmatched + 1
       
    End If
       

Next fill_unmatched

Sheet1.Cells(15, 4) = r_unmatched - 1
Sheet1.Cells(14, 4) = s_row - r_unmatched

End Sub

 

[jindon]

try

Sub test()
    Dim rng As Range, r As Range, e
    Set rng = Sheets("master").Cells(1).CurrentRegion
    With Sheets("slave").Cells(1).CurrentRegion
        Set r = .Offset(, .Columns.Count + 2).Cells(1).Resize(2)
        For Each e In Array(Array("=isnumber(match(a2," & rng.Columns(1).Address(external:=True) & ",0))", "Matched"), _
            Array("=iserror(match(a2," & rng.Columns(1).Address(external:=True) & ",0))", "Un-matched"))
            Sheets(e(1)).Cells.Clear
            r(2).Formula = e(0)
            .AdvancedFilter 2, r, Sheets(e(1)).[c1].Offset(, IIf(e(1) = "Un-matched", -2, 0))
            If e(1) = "Matched" Then
                With Sheets(e(1))
                    rng.Rows(1).Copy .Cells(1)
                    With .Range("c2", .Range("c" & .Rows.Count).End(xlUp)).Offset(, -2).Resize(, 2)
                        .Formula = Array("=c2", "=vlookup(a2," & rng.Address(external:=True) & ",2,0)")
                    End With
                End With
            End If
        Next
        r.Clear
    End With
End Sub