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]

I closed all of excel. Used the previous code you gave me, and I got no error this time.

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
   
   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)) [COLOR=#008080]'<< Looks in col A of the master sheet for the names[/COLOR]
         If Not .exists(Cl.Value) Then .Add Cl.Value, Cl [COLOR=#008080]'<< Adds the names to a dictionary[/COLOR]
      Next Cl
      
      FileName = Dir(Path & "*.xls*")
      
       Do While Len(FileName) > 0
         Set wbk = Workbooks.Open(Path & FileName)
         Set Sht = wbk.Sheets(2)
         For Each Rng In Sht.Range("B2", Sht.Range("B" & Rows.Count).End(xlUp))[COLOR=#008080] '<< Looks in col B of the new wbk for the names[/COLOR]
            If .exists(Rng.Value) Then [COLOR=#008080]'<< checks if the name is in the dictionary (ie in the Master sheet)[/COLOR]
               .Item(Rng.Value).Offset(, 5).Value = Rng.Offset(, 6).Value            [COLOR=#008080]  '<< adds the value to the master[/COLOR]
               .Item(Rng.Value).Offset(, 10).Value = wbk.Sheets(1).Range("C7").Value  [COLOR=#008080] '<< adds the date to the master[/COLOR]
               .Item(Rng.Value).Offset(, 9).Value = wbk.Sheets(1).Range("F7").Value   [COLOR=#008080] '<< add the certificate to the master[/COLOR]
            End If
         Next Rng
         wbk.Close False
         FileName = Dir
      Loop
   End With
End Sub

And it worked for only 1 file. The dates and certificates from only 1 sheet updated (for example, it looks like it only opened 1 file from the folder). The values did not update however.

Thank you so so much!

 

[Fluff]

Try

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
   [COLOR=#0000ff]Dim Cnt As Long[/COLOR]
   
   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)
         [COLOR=#0000ff]Cnt = Cnt + 1[/COLOR]
         Set Sht = wbk.Sheets(2)
         For Each Rng In Sht.Range("B2", 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(, [COLOR=#ff0000]5[/COLOR]).Value              '<< adds the value to the master
               .Item(Rng.Value).Offset(, 10).Value = wbk.Sheets(1).Range("C7").Value   '<< adds the date to the master
               .Item(Rng.Value).Offset(, 9).Value = wbk.Sheets(1).Range("F7").Value    '<< add the certificate to the master
            End If
         Next Rng
         wbk.Close False
         FileName = Dir
      Loop
   End With
   [COLOR=#0000ff]MsgBox Cnt[/COLOR]
End Sub

The value in red was wrong (I originally miscounted)
Also this will bring up a message box showing how many files were opened, which are the lines in blue

 

[sgeng4]

Thank you so much Fluff! I appreciate you.

Everything is working!!! =)

 

[Fluff]

Glad to help & thanks for the feedback.

If you don't want the msgbox any more, simply delete the lines in blue

 

[sgeng4]

Thank you so much! =)

Would it be possible that the code won't work if the file is protected? On any test files I use, the code works perfectly, or if I copy and paste the information in the worksheets into another file, however it isn't working from the original files. I presume because they are locked for editing/ protected sheets. Would there possibly be another reason for the code to not work?

 

[Fluff]

Are you talking about the files that the macro opens, or the file you are writing the data to.

 

[sgeng4]

The macro opens the files, but the values, certificate and dates aren't copying over to the master sheet.

 

[Fluff]

Do the files or the master sheet have sheet protection?
Also do you have any merged cells?

 

[sgeng4]

The Files have sheet protection. And there are a few merged cells.

 

[Fluff]

I've doubled checked the sheet protection and that shouldn't be an issue as we are only copying from those files.
Do the merged cells occur in the areas we are copying data from?
Also are the names in the master sheet EXACTLY the same as the files being opened (ie no trailing, or leading spaces and matching case).