Should I consider any obvious methods or restructuring to speed up macro?

[JamesJones25]

I have a a macro that recursively loops through 37,000 rows of an Excel file to try and find a matching file name in a synced sharepoint file system (Year folders and sub-quarter folders). The conditions are as follows -

1. If a file is found, add the file information to the respective row.
2. If a file is not found, print "Not Found" in the respective row.
3. If a duplicate file is found in any of the folders (it could be the same folder) only add the information of the most recent file found based on the file's modified timestamp.

Currently, this macro takes over 13 hours to run to completion.

Is there anything I can do to help speed it up?

Sub RecursiveLoop(folderPath As String, ws As Worksheet)
    Dim fs As Object
    Dim folder As Object
    Dim subfolder As Object
    Dim subsubfolder As Object
    Dim file As Object
    Dim subfolderPath As String
    Dim currentRow As Long
    Dim excelFileName As String
    Dim found As Boolean
    Dim recentFiles As New Dictionary ' Create a dictionary to store recent files
    

    spaddress = "/test/"

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set folder = fs.GetFolder(folderPath)

    For Each subfolder In folder.SubFolders ' Loop through year subfolders
        subfolderPath = subfolder.Path
        For Each subsubfolder In subfolder.SubFolders ' Loop through quarter subfolders
            found = False ' Reset the found flag for each quarter subfolder
            ' Clear the recentFiles dictionary for each sub-subfolder
            Set recentFiles = New Dictionary
            
            For i = 3 To ws.Cells(Rows.Count, "M").End(xlUp).Row
                excelFileName = ws.Cells(i, "M").Value
                For Each file In subsubfolder.Files
                    If InStr(1, file.Name, GetFileNameWithoutExtension(excelFileName), vbTextCompare) > 0 Then
                        ' Check if this is the most recent file for this excelFileName
                        If Not recentFiles.Exists(excelFileName) Then
                            ' If the file is not in the dictionary, add it
                            Set recentFiles(excelFileName) = file
                        ElseIf file.DateLastModified > recentFiles(excelFileName).DateLastModified Then
                            ' If the file is more recent, update the dictionary entry
                            Set recentFiles(excelFileName) = file
                        End If
                    End If
                Next file
                
                ' Process the most recent file for this excelFileName
                If recentFiles.Exists(excelFileName) Then
                    Set recentFile = recentFiles(excelFileName)
                    ws.Cells(i, "J").Value = "Approved by " & GetTrailingName(recentFile.Name, GetFileNameWithoutExtension(excelFileName))
                    pdfLink = Replace(excelFileName, " ", "%20")
                    If ws.Cells(i, "H") <> "" And ws.Cells(i, "E") = "" Then
                        ws.Hyperlinks.Add Anchor:=ws.Cells(i, "K"), Address:=spaddress & recentFile.Name, TextToDisplay:="link"
                    ElseIf ws.Cells(i, "E") <> "" And ws.Cells(i, "H") = "" Then
                        ws.Hyperlinks.Add Anchor:=ws.Cells(i, "L"), Address:=spaddress & recentFile.Name, TextToDisplay:="link"
                    ElseIf ws.Cells(i, "E") <> "" And ws.Cells(i, "H") <> "" Then
                        ws.Hyperlinks.Add Anchor:=ws.Cells(i, "K"), Address:=spaddress & recentFile.Name, TextToDisplay:="link"
                    End If
                End If
                
                found = True ' Mark as found if the file is found
            Next i
        Next subsubfolder
    Next subfolder

    Set fs = Nothing
    Set folder = Nothing
    Set subfolder = Nothing
    Set subsubfolder = Nothing
    Set file = Nothing
End Sub

 

[Herakles]

I have a a macro that recursively loops through 37,000 rows of an Excel file to try and find a matching file name in a synced sharepoint file system (Year folders and sub-quarter folders). The conditions are as follows -

1. If a file is found, add the file information to the respective row.
2. If a file is not found, print "Not Found" in the respective row.
3. If a duplicate file is found in any of the folders (it could be the same folder) only add the information of the most recent file found based on the file's modified timestamp.

Currently, this macro takes over 13 hours to run to completion.

Is there anything I can do to help speed it up?

Sub RecursiveLoop(folderPath As String, ws As Worksheet)
    Dim fs As Object
    Dim folder As Object
    Dim subfolder As Object
    Dim subsubfolder As Object
    Dim file As Object
    Dim subfolderPath As String
    Dim currentRow As Long
    Dim excelFileName As String
    Dim found As Boolean
    Dim recentFiles As New Dictionary ' Create a dictionary to store recent files
   

    spaddress = "/test/"

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set folder = fs.GetFolder(folderPath)

    For Each subfolder In folder.SubFolders ' Loop through year subfolders
        subfolderPath = subfolder.Path
        For Each subsubfolder In subfolder.SubFolders ' Loop through quarter subfolders
            found = False ' Reset the found flag for each quarter subfolder
            ' Clear the recentFiles dictionary for each sub-subfolder
            Set recentFiles = New Dictionary
           
            For i = 3 To ws.Cells(Rows.Count, "M").End(xlUp).Row
                excelFileName = ws.Cells(i, "M").Value
                For Each file In subsubfolder.Files
                    If InStr(1, file.Name, GetFileNameWithoutExtension(excelFileName), vbTextCompare) > 0 Then
                        ' Check if this is the most recent file for this excelFileName
                        If Not recentFiles.Exists(excelFileName) Then
                            ' If the file is not in the dictionary, add it
                            Set recentFiles(excelFileName) = file
                        ElseIf file.DateLastModified > recentFiles(excelFileName).DateLastModified Then
                            ' If the file is more recent, update the dictionary entry
                            Set recentFiles(excelFileName) = file
                        End If
                    End If
                Next file
               
                ' Process the most recent file for this excelFileName
                If recentFiles.Exists(excelFileName) Then
                    Set recentFile = recentFiles(excelFileName)
                    ws.Cells(i, "J").Value = "Approved by " & GetTrailingName(recentFile.Name, GetFileNameWithoutExtension(excelFileName))
                    pdfLink = Replace(excelFileName, " ", "%20")
                    If ws.Cells(i, "H") <> "" And ws.Cells(i, "E") = "" Then
                        ws.Hyperlinks.Add Anchor:=ws.Cells(i, "K"), Address:=spaddress & recentFile.Name, TextToDisplay:="link"
                    ElseIf ws.Cells(i, "E") <> "" And ws.Cells(i, "H") = "" Then
                        ws.Hyperlinks.Add Anchor:=ws.Cells(i, "L"), Address:=spaddress & recentFile.Name, TextToDisplay:="link"
                    ElseIf ws.Cells(i, "E") <> "" And ws.Cells(i, "H") <> "" Then
                        ws.Hyperlinks.Add Anchor:=ws.Cells(i, "K"), Address:=spaddress & recentFile.Name, TextToDisplay:="link"
                    End If
                End If
               
                found = True ' Mark as found if the file is found
            Next i
        Next subsubfolder
    Next subfolder

    Set fs = Nothing
    Set folder = Nothing
    Set subfolder = Nothing
    Set subsubfolder = Nothing
    Set file = Nothing
End Sub

I would download a list of all of the files on Sharepoint into a worksheet and put the 37k list and this file list each into an array and process the data
in that way.

Try this link here for ideas on how to download the file list.

Regarding this:

1. If a duplicate file is found in any of the folders (it could be the same folder) only add the information of the most recent file found based on the file's modified timestamp.

Could it be the case that more than one file have the same name and they are in fact different files and not just dfferent versions of the same file?