Automating MATCH result data copying

%3CLINGO-SUB%20id%3D%22lingo-sub-3396468%22%20slang%3D%22en-US%22%3EAutomating%20MATCH%20result%20data%20copying%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-3396468%22%20slang%3D%22en-US%22%3E%3CP%3EI%20am%20going%20preface%20this%20with%20a%20warning%20that%20I%20am%20clueless.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EFirst%20an%20overview%20of%20what%20I%20am%20trying%20to%20accomplish.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EThis%20is%20in%20Excel%20365%3C%2FP%3E%3CP%3EI%20have%20a%20source%20sheet%20that%20is%20generated%20by%20an%20application%20once%2Fweek.%26nbsp%3B%20The%20report%20contains%20both%20data%20that%20has%20changed%20since%20last%20run%20and%20new%20data.%20The%20file%20name%20changes%20each%20time%20that%20it%20is%20run%2C%20the%20file%20is%20then%20deleted%20so%20no%20formulas%20can%20be%20stored%20in%20it.%26nbsp%3B%20I%20do%20maintain%20a%20personal.xlsb%20file%20with%20vba.%3C%2FP%3E%3CP%3ESource%20and%20destination%20sheets%20are%20formatted%20the%20same.%26nbsp%3B%3C%2FP%3E%3CP%3EData%20in%20the%20source%20will%20have%20new%20rows%20that%20should%20be%20appended%20to%20the%20destination%26nbsp%3B%3C%2FP%3E%3CP%3EData%20in%20the%20source%20will%20have%20existing%20data%20that%20will%20have%20changed%20and%20should%20overwrite%20the%20destination%20sheet.%26nbsp%3B%20Column%20A%20is%20the%20key%20for%20matching%2C%20this%20cell%20does%20not%20change.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EAt%20the%20moment%2C%20I%20am%20using%26nbsp%3B%20%26nbsp%3B%3DMATCH(A%3AA%2Creport1652227282759.xlsx!%24A%3A%24A%2C0)%26nbsp%3B%20in%20the%20last%20column%20on%20every%20row%20of%20the%20destination%20sheet%20to%20locate%20the%20matching%20(changed)%20rows%20on%20the%20source%20sheet.%26nbsp%3B%20The%20then%20filter%20out%20the%20%23N%2FA%20cells%20and%20copy%20the%20entire%20contents%20of%20the%20source%20to%20the%20destination.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EMy%20goal%20is%20to%20automate%20this.%26nbsp%3B%3C%2FP%3E%3CP%3E1)%20Modify%20the%20formula%20so%20that%20the%20report%20name%20is%20whatever%20the%20source%20file%20is%20when%20I%20am%20running%20it.%26nbsp%3B%20(report%23%23%23%23.xls)%26nbsp%3B%20dim%20ws%20as%20worksheet%26nbsp%3B%26nbsp%3B%20%26nbsp%3Bset%20ws%3Dthisworkbook.activesheet%20%3F%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E2)%20Copy%20the%20formula%20to%20every%20row%20on%20the%20destination%20each%20time%20I%20run%20the%20report%20without%20manually%20selecting%20all%20rows%20and%20using%20CTRL%2BD.%26nbsp%3B%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E3)%20Filter%20out%20%23N%2FA%20on%20the%20Destination%20(Daily%20cases.XLS)%3C%2FP%3E%3CP%3E4)%20copy%20the%20contents%20of%20the%20source%20XLS%20to%20the%20destination%20XLS.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20hope%20this%20make%20sense%20to%20you%20much%20smarter%20than%20me%20Excel%20folks.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20am%20wide%20open%20to%20scraping%20the%20entire%20approach%20if%20there%20is%20a%20better%20way.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EFile%20samples%20are%20attached.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-3396468%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EExcel%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EFormulas%20and%20Functions%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EMacros%20and%20VBA%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-3397188%22%20slang%3D%22en-US%22%3ERe%3A%20Automating%20MATCH%20result%20data%20copying%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-3397188%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F1375171%22%20target%3D%22_blank%22%3E%40jjelliott%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EIn%20the%20attached%2C%20you%20will%20find%20two%20buttons%20(look%20at%20the%20range%20O1%3AS1)%20called%20%22Match%20Cases%20With%20Report%20File%22%20and%20%22Show%20All%20Data%22.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EIf%20you%20click%20the%20button%20called%20%22Match%20Cases%20With%20Report%20File%22%2C%20it%20will%20open%20a%20file%20picker%20dialogbox%20for%20you%2C%20please%20browse%20and%20select%20your%20report%20file%20and%20click%20open%20to%20continue.%20The%20code%20will%20then%20do%20the%20rest%20job%20and%20filter%20column%20M%20to%20show%20you%20the%20matching%20row%23%20from%20the%20report%20file.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ETo%20see%20all%20the%20data%20again%2C%20just%20click%20on%20the%20Show%20All%20Data%20button.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%3CU%3E%3CSTRONG%3ECode%20for%20Module1%3A%3C%2FSTRONG%3E%3C%2FU%3E%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-visual-basic%22%3E%3CCODE%3EOption%20Explicit%0A%0ASub%20MatchCaseNumbersWithReportFile()%0ADim%20dwb%20%20%20%20%20%20%20%20%20%20%20%20%20As%20Workbook%0ADim%20swb%20%20%20%20%20%20%20%20%20%20%20%20%20As%20Workbook%0ADim%20dws%20%20%20%20%20%20%20%20%20%20%20%20%20As%20Worksheet%0ADim%20sws%20%20%20%20%20%20%20%20%20%20%20%20%20As%20Worksheet%0ADim%20srcRepotPath%20%20%20%20As%20String%0ADim%20lr%20%20%20%20%20%20%20%20%20%20%20%20%20%20As%20Long%0ADim%20dict%20%20%20%20%20%20%20%20%20%20%20%20As%20Object%0ADim%20x%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20As%20Variant%0ADim%20y%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20As%20Variant%0ADim%20i%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20As%20Long%0ADim%20j%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20As%20Long%0ADim%20arrOut()%20%20%20%20%20%20%20%20As%20Variant%0A%0AApplication.ScreenUpdating%20%3D%20False%0A%0ASet%20dwb%20%3D%20ThisWorkbook%0ASet%20dws%20%3D%20dwb.Worksheets(%22Cases%22)%0A%0ASet%20dict%20%3D%20CreateObject(%22Scripting.Dictionary%22)%0A%0AWith%20Application.FileDialog(msoFileDialogFilePicker)%0A%20%20%20%20.Title%20%3D%20%22Select%20a%20Report%20File%20to%20Match%20CaseNumbers%22%0A%20%20%20%20.AllowMultiSelect%20%3D%20False%0A%20%20%20%20.Filters.Clear%0A%20%20%20%20.Filters.Add%20%22Excel%20Files%22%2C%20%22*.xls*%22%0A%20%20%20%20%0A%20%20%20%20If%20.Show%20%3D%20-1%20Then%0A%20%20%20%20%20%20%20%20srcRepotPath%20%3D%20.SelectedItems(1)%0A%20%20%20%20Else%0A%20%20%20%20%20%20%20%20MsgBox%20%22You%20didn't%20select%20any%20Report%20File!%22%2C%20vbCritical%0A%20%20%20%20%20%20%20%20Exit%20Sub%0A%20%20%20%20End%20If%0AEnd%20With%0A%0ASet%20swb%20%3D%20Workbooks.Open(srcRepotPath%2C%20False)%0ASet%20sws%20%3D%20swb.Worksheets(1)%0A%0Ax%20%3D%20sws.Range(%22A1%22).CurrentRegion.Value%0A%0AFor%20i%20%3D%202%20To%20UBound(x%2C%201)%0A%20%20%20%20dict.Item(x(i%2C%201))%20%3D%20i%0ANext%20i%0A%0Aswb.Close%20False%0A%0AIf%20dws.FilterMode%20Then%20dws.ShowAllData%0A%0Ay%20%3D%20dws.Range(%22A1%22).CurrentRegion.Value%0A%0AReDim%20arrOut(1%20To%20UBound(y%2C%201)%20-%201%2C%201%20To%201)%0A%0AFor%20i%20%3D%202%20To%20UBound(y%2C%201)%0A%20%20%20%20j%20%3D%20j%20%2B%201%0A%20%20%20%20If%20dict.exists(y(i%2C%201))%20Then%0A%20%20%20%20%20%20%20%20arrOut(j%2C%201)%20%3D%20dict(y(i%2C%201))%0A%20%20%20%20Else%0A%20%20%20%20%20%20%20%20arrOut(j%2C%201)%20%3D%20%22%22%0A%20%20%20%20End%20If%0ANext%20i%0A%0Adws.Range(%22M2%22).Resize(j%2C%201).Value%20%3D%20arrOut%0A%0AWith%20dws.Range(%22A1%3AM1%22)%0A%20%20%20%20.AutoFilter%20field%3A%3D13%2C%20Criteria1%3A%3D%22%26lt%3B%26gt%3B%22%0AEnd%20With%0AApplication.ScreenUpdating%20%3D%20True%0AEnd%20Sub%0A%0ASub%20ShowAllData()%0AIf%20ActiveSheet.FilterMode%20Then%20ActiveSheet.ShowAllData%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-3401874%22%20slang%3D%22en-US%22%3ERe%3A%20Automating%20MATCH%20result%20data%20copying%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-3401874%22%20slang%3D%22en-US%22%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F394231%22%20target%3D%22_blank%22%3E%40Subodh_Tiwari_sktneer%3C%2FA%3E%3CBR%20%2F%3E%3CBR%20%2F%3EThank%20you.%20That%20is%20a%20nice%20way%20to%20save%20me%20from%20manually%20copying%20the%20code.%20My%20hope%20was%20to%20nat%20have%20to%20save%20the%20source%20file%20but%20that%20is%20a%20minor%20issue.%20Unfortunately%2C%20it%20does%20not%20accomplish%20my%20goal%20of%20replacing%20the%20rows%20in%20the%20%22daily%20cases%22%20worksheet%20with%20the%20matching%20rows%20in%20the%20%22reportxxxxx%22%20worksheet%20and%20appending%20the%20new%20any%20non-matching%20(therefore%2C%20new)%20rows%20to%20the%20end%20of%20the%20%22Daily%20Cases'%20sheet.%3C%2FLINGO-BODY%3E
Occasional Contributor

I am going preface this with a warning that I am clueless.

 

First an overview of what I am trying to accomplish.

 

This is in Excel 365

I have a source sheet that is generated by an application once/week.  The report contains both data that has changed since last run and new data. The file name changes each time that it is run, the file is then deleted so no formulas can be stored in it.  I do maintain a personal.xlsb file with vba.

Source and destination sheets are formatted the same. 

Data in the source will have new rows that should be appended to the destination 

Data in the source will have existing data that will have changed and should overwrite the destination sheet.  Column A is the key for matching, this cell does not change.

 

At the moment, I am using   =MATCH(A:A,report1652227282759.xlsx!$A:$A,0)  in the last column on every row of the destination sheet to locate the matching (changed) rows on the source sheet.  The then filter out the #N/A cells and copy the entire contents of the source to the destination.

 

My goal is to automate this. 

1) Modify the formula so that the report name is whatever the source file is when I am running it.  (report####.xls)  dim ws as worksheet    set ws=thisworkbook.activesheet ?

 

2) Copy the formula to every row on the destination each time I run the report without manually selecting all rows and using CTRL+D.  

 

3) Filter out #N/A on the Destination (Daily cases.XLS)

4) copy the contents of the source XLS to the destination XLS.

 

I hope this make sense to you much smarter than me Excel folks.

 

I am wide open to scraping the entire approach if there is a better way.

 

File samples are attached.

 

2 Replies

@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

 

 

@Subodh_Tiwari_sktneer

Thank you. That is a nice way to save me from manually copying the code. My hope was to nat have to save the source file but that is a minor issue. Unfortunately, it does not accomplish my goal of replacing the rows in the "daily cases" worksheet with the matching rows in the "reportxxxxx" worksheet and appending the new any non-matching (therefore, new) rows to the end of the "Daily Cases' sheet.