Automating MATCH result data copying

jjelliott 

In the attached, you will find two buttons (look at the range O1:S1) called "Match Cases With Report File" and "Show All Data".

If you click the button called "Match Cases With Report File", it will open a file picker dialogbox for you, please browse and select your report file and click open to continue. The code will then do the rest job and filter column M to show you the matching row# from the report file.

To see all the data again, just click on the Show All Data button.

Code for Module1:

Option Explicit

Sub MatchCaseNumbersWithReportFile()
Dim dwb             As Workbook
Dim swb             As Workbook
Dim dws             As Worksheet
Dim sws             As Worksheet
Dim srcRepotPath    As String
Dim lr              As Long
Dim dict            As Object
Dim x               As Variant
Dim y               As Variant
Dim i               As Long
Dim j               As Long
Dim arrOut()        As Variant

Application.ScreenUpdating = False

Set dwb = ThisWorkbook
Set dws = dwb.Worksheets("Cases")

Set dict = CreateObject("Scripting.Dictionary")

With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Select a Report File to Match CaseNumbers"
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Excel Files", "*.xls*"
    
    If .Show = -1 Then
        srcRepotPath = .SelectedItems(1)
    Else
        MsgBox "You didn't select any Report File!", vbCritical
        Exit Sub
    End If
End With

Set swb = Workbooks.Open(srcRepotPath, False)
Set sws = swb.Worksheets(1)

x = sws.Range("A1").CurrentRegion.Value

For i = 2 To UBound(x, 1)
    dict.Item(x(i, 1)) = i
Next i

swb.Close False

If dws.FilterMode Then dws.ShowAllData

y = dws.Range("A1").CurrentRegion.Value

ReDim arrOut(1 To UBound(y, 1) - 1, 1 To 1)

For i = 2 To UBound(y, 1)
    j = j + 1
    If dict.exists(y(i, 1)) Then
        arrOut(j, 1) = dict(y(i, 1))
    Else
        arrOut(j, 1) = ""
    End If
Next i

dws.Range("M2").Resize(j, 1).Value = arrOut

With dws.Range("A1:M1")
    .AutoFilter field:=13, Criteria1:="<>"
End With
Application.ScreenUpdating = True
End Sub

Sub ShowAllData()
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
End Sub