Macro to open files in a folder, copy data if there is a match, close them

[sgeng4]

Hi all,

I'm looking for some help making a macro.

I have a bunch of files in a folder. I want a macro that opens up each file one by one, and if the names match, then copy the value, date and certificate associated with that name onto the master spreadsheet.


So in the folder, I have excel files that have the following information in each sheet in the second tab:


[table="width: 500", class: grid"]
[tr]
[td]Certificate[/td]
[td]A8[/td]
[/tr]
[tr]
[td]date[/td]
[td]Dec 9[/td]
[/tr]
[tr]
[td]name2[/td]
[td]1.3[/td]
[/tr]
[tr]
[td]name3[/td]
[td]1.5[/td]
[/tr]
[tr]
[td]name6[/td]
[td]3.0[/td]
[/tr]
[/table]

In the master sheet, I have the following columns:
[table="width: 500, class: grid"]
[tr]
[td]UNIQUENAME[/td]
[td]VALUE[/td]
[td]DATE[/td]
[td]CERTIFICATE[/td]
[/tr]
[tr]
[td]name1[/td]
[td][/td]
[td][/td]
[td][/td]
[/tr]
[tr]
[td]name2[/td]
[td][/td]
[td][/td]
[td][/td]
[/tr]
[tr]
[td]name3[/td]
[td][/td]
[td][/td]
[td][/td]
[/tr]
[/table]

I am looking for a way for excel to automatically fill in the value, date, and certificate numbers by looking them up in the sheets and pasting them into the correct row. For example, like so:




[table="width: 500, class: grid"]
[tr]
[td]UNIQUENAME[/td]
[td]VALUE[/td]
[td]DATE[/td]
[td]CERTIFICATE[/td]
[/tr]
[tr]
[td]name1[/td]
[td][/td]
[td][/td]
[td][/td]
[/tr]
[tr]
[td]name2[/td]
[td]1.3[/td]
[td]Dec 9[/td]
[td]A8[/td]
[/tr]
[tr]
[td]name3[/td]
[td]1.5[/td]
[td]Dec 9[/td]
[td]A8[/td]
[/tr]
[/table]



So far, I got the macro to open the file folder, and open the files one by one, but I don't know how to code it so it searches for matches, and copies the correct cells over.

Sub CompleteMasterSpreadsheet()
'DECLARE AND SET VARIABLES
Dim wbk As Workbook
Dim FileName As String
Dim Path As String


With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    Path = .SelectedItems(1) & "\"
End With

FileName = Dir(Path & "*.xls*")

'Loop to open excel files

 Do While Len(FileName) > 0  'IF NEXT FILE EXISTS THEN
    Set wbk = Workbooks.Open(Path & FileName)
    '
    ' CODE to search for matches, copy them if there is a match
    '

    
    ' end of code

     
    wbk.Close True
    FileName = Dir
Loop
End Sub

Help is really appreciated!

Thank you. =)

 

[sgeng4]

It seems to only work if I copy and paste the information from the original files into a new sheet. The names in the master sheet are EXACTLY the same. I've checked it a few times with protection and locking the cells, and also came to the same conclusion. I can't seem to figure out why it's not copying the information from the original files.

 

[Fluff]

Without being able to see your files it's very difficult to help.
Would you be willing to upload your master file & one of the other files to either dropbox, or OneDrive, mark for sharing & then paste a link to this thread?

 

[sgeng4]

I've uploaded it to Files.fm at this link:
https://files.fm/u/vcwveu4d

Thank you so much again!

 

[Fluff]

Thanks for the files. The problem is that sheets(1) is hidden, so the macro was looking at the wrong sheets.
Try this

Sub CompleteMasterSpreadsheet()
   'DECLARE AND SET VARIABLES
   Dim wbk As Workbook
   Dim Sht As Worksheet
   Dim FileName As String
   Dim Path As String
   Dim Cl As Range
   Dim Rng As Range
   Dim Cnt As Long
   
Application.ScreenUpdating = False

   With Application.FileDialog(4)
       .Show
       Path = .SelectedItems(1) & "\"
   End With
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp)) '<< Looks in col A of the master sheet for the names
         If Not .exists(Cl.Value) Then .Add Cl.Value, Cl '<< Adds the names to a dictionary
      Next Cl
      
      FileName = Dir(Path & "*.xls*")
      
       Do While Len(FileName) > 0
         Set wbk = Workbooks.Open(Path & FileName)
         Cnt = Cnt + 1
         Set Sht = wbk.Sheets("[COLOR=#0000ff]Values[/COLOR]")
         For Each Rng In Sht.Range("B7", Sht.Range("B" & Rows.Count).End(xlUp)) '<< Looks in col B of the new wbk for the names
            If .exists(Rng.Value) Then '<< checks if the name is in the dictionary (ie in the Master sheet)
               .Item(Rng.Value).Offset(, 5).Value = Rng.Offset(, 5).Value              '<< adds the value to the master
               .Item(Rng.Value).Offset(, 10).Value = wbk.Sheets("[COLOR=#0000ff]Shift[/COLOR]").Range("C7").Value   '<< adds the date to the master
               .Item(Rng.Value).Offset(, 9).Value = wbk.Sheets("[COLOR=#0000ff]Shift[/COLOR]").Range("F7").Value    '<< add the certificate to the master
            End If
         Next Rng
         wbk.Close False
         FileName = Dir
      Loop
   End With
   MsgBox Cnt
End Sub

This assumes that each file you're opening has a sheet called Values & a sheet called Shift

 

[sgeng4]

Thank you so so so much! I would have never realized that the sheet was hidden. You're amazing!! I added a few lines so it unhides the worksheets instead of using the name Values and Shift, just in case some of the files don't have the same names or is missing a capital, etc.

Thank you so much for sticking with me too. =)

Sub CompleteMasterSpreadsheet()
   'DECLARE AND SET VARIABLES
   Dim wbk As Workbook
   Dim Sht As Worksheet
   Dim FileName As String
   Dim Path As String
   Dim Cl As Range
   Dim Rng As Range
   Dim Cnt As Long
   
Application.ScreenUpdating = False


   With Application.FileDialog(4)
       .Show
       Path = .SelectedItems(1) & "\"
   End With
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp)) '<< Looks in col A of the master sheet for the names
         If Not .exists(Cl.Value) Then .Add Cl.Value, Cl '<< Adds the names to a dictionary
      Next Cl
      
      FileName = Dir(Path & "*.xls*")
      
       Do While Len(FileName) > 0
         Set wbk = Workbooks.Open(Path & FileName)


'unhide all worksheets
             For Each WS In ActiveWorkbook.Worksheets
             WS.Visible = xlSheetVisible
             Next WS


         Cnt = Cnt + 1
         Set Sht = wbk.Sheets("Values")
         For Each Rng In Sht.Range("B7", Sht.Range("B" & Rows.Count).End(xlUp)) '<< Looks in col B of the new wbk for the names
            If .exists(Rng.Value) Then '<< checks if the name is in the dictionary (ie in the Master sheet)
               .Item(Rng.Value).Offset(, 5).Value = Rng.Offset(, 5).Value              '<< adds the value to the master
               .Item(Rng.Value).Offset(, 10).Value = wbk.Sheets("Shift").Range("C7").Value   '<< adds the date to the master
               .Item(Rng.Value).Offset(, 9).Value = wbk.Sheets("Shift").Range("F7").Value    '<< add the certificate to the master
            End If
         Next Rng
         wbk.Close False
         FileName = Dir
      Loop
   End With
   MsgBox Cnt
End Sub

 

[Fluff]

Glad to help & thanks for the feedback