Macro to automatically pull cells from thousands of workbooks into one master workbook

[mspwc]

Hello!

I have been a long time lurker but first time making an account and posting.

I am tasked with taking a folder with many (up to thousands) of single sheet workbooks and getting about 5-7 nonconsecutive cells and moving them into a master workbook. (I specifically want cells A10, A11, A6, A55, A56 in that order) to populate across one row in the master workbook, and then eventually take cells A55 and A56 and run a macro to see if values are within a certain threshold of one another.

There are some caveats which I think are making this more difficult for me:
1. The files are not excel files but "cal files" which are text files... If they need to be excel files I will need to find a way to change all of them
2. Each workbook in the folder has a different name and a single sheet with a single column (which I would like to add a macro to separate these by an = sign before they get transferred to the master workbook)
3. I believe these folders will be getting new files regularly, so it would be nice to have some sort of update button that will not duplicate or delete other files.

This is a lot, but any help would be insanely appreciated!

Here is some code I have tried and been playing with:

Sub RefreshMasterList()


    Const SRC_FOLDER As String = "Z:\"
    Const COL_FNAME As Long = 1
    Const COL_LAST_MOD As Long = 2


    Dim fso As New Scripting.FileSystemObject
    Dim fold As Scripting.Folder, fl As Scripting.File
    Dim f As Range, sht As Worksheet, rw As Range, dtlm
    Dim getInfo As Boolean, wb As Workbook, ws As Worksheet
    Dim baseName As String


    Set sht = ThisWorkbook.Sheets("Master")


    'clear all file status flag colors
    sht.Columns(COL_FNAME).Interior.ColorIndex = xlNone


    Set fold = fso.GetFolder(SRC_FOLDER)
    For Each fl In fold.Files
        If fl.Name Like "*.xls*" Then
            getInfo = False
            dtlm = Format(fl.DateLastModified, "yyyy-mm-dd-hh:mm:ss")
            baseName = fso.GetBaseName(fl.Name)


            'have this file already ?
            Set f = sht.Columns(1).Find(baseName, lookat:=xlWhole, _
                                         LookIn:=xlValues)
            If f Is Nothing Then 'not already listed...
                Set rw = sht.Cells(Rows.Count, COL_FNAME).End(xlUp) _
                                    .Offset(1, 0).EntireRow
                With rw
                    .Cells(COL_FNAME).Value = baseName
                    'flag new
                    .Cells(COL_FNAME).Interior.Color = vbGreen
                    .Cells(COL_LAST_MOD).Value = dtlm
                End With
                getInfo = True
            Else
                Set rw = f.EntireRow
                If rw.Cells(COL_LAST_MOD).Value < dtlm Then
                    Debug.Print f.Cells(COL_LAST_MOD).Value, dtlm
                    'flag updated
                    rw.Cells(COL_FNAME).Interior.Color = vbYellow
                    rw.Cells(COL_LAST_MOD).Value = dtlm
                    getInfo = True
                Else
                    'flag no change
                    rw.Cells(COL_FNAME).Interior.Color = RGB(220, 220, 220)
                End If
            End If


            If getInfo Then 'need to add/update from this file?
                Set wb = Workbooks.Open(fl.Path, , True)
                With wb.Sheets("Purchase Order")
                    rw.Cells(3).Value = .Range("A10").Value
                    rw.Cells(4).Value = .Range("A11").Value
                    'etc...
                End With
                wb.Close False 'don't save...
            End If


        End If
    Next fl
End Sub

as well as

Sub ConsolidateWbks()


    Dim Pth As String
    Dim MstSht As Worksheet
    Dim fname As String
    Dim Rng As Range
    
Application.ScreenUpdating = False


    Pth = "L:\Stormwater\Data\EXO Calibration Files\Calibration Files\0003"
    Set MstSht = ThisWorkbook.Sheets("Sheet1")
    fname = Dir(Pth & "*xls*")
    Do While Len(fname) > 0
        Workbooks.Open (Pth & fname)
        With Workbooks(fname)
            Set Rng = MstSht.Range("E" & Rows.Count).End(xlUp).Offset(1)
            Rng.Resize(, 34).Value = Application.Transpose(.Sheets("Global FACT").Range("B2:B35").Value)
            Rng.Offset(, 35).Value = .Sheets("Global FACT").Range("C36").Value
            Rng.Offset(, 36).Value = .Sheets("CRF").Range("C12").Value
            Rng.Offset(, 37).Value = .Sheets("CRF").Range("C16").Value
            Rng.Offset(, 38).Value = .Sheets("CRF").Range("G4").Value
            Application.DisplayAlerts = False
            .Close , False
            Application.DisplayAlerts = True
        End With
        fname = Dir
    Loop


End Sub

The above code was taken from other websites and I have attempted to make it work with my needs, but to no avail.

Thanks again!

 

[mole999]

not sure how to do this, but make sure you pull the file name when you get the data otherwise you won't know where it came from