Run Macro across files in sub folders

[Prabu_sanku]

Hi I have a macro which I want to run across multiple excel files in multiple sub folders

eg: Main folder - USA
sub folders -
1. New york
2. Washington
3. California

Each of the above subfolder contains multiple excel files. I found the below code which runs on excel files in a single folder. Please help in modifying this for runnibg across sub folders



Public Sub Format_All_Workbooks()

Dim folderPath As String
Dim fileName As String
Dim wb As Workbook

folderPath = "Folder path entered here"

If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"

Application.ScreenUpdating = False

fileName = Dir(folderPath & "*.xls*")
Do While fileName <> ""
Set wb = Workbooks.Open(folderPath & fileName)
Clean_Tally_Data
wb.Close SaveChanges:=True
fileName = Dir
Loop

Application.ScreenUpdating = True

End Sub

Sub Clean_Tally_Data()

Dim rng As Range
Set rng = Range("B1:E2000")

For Each cell In rng

If InStr(1, cell.NumberFormat, "Cr") > 0 Then
cell.Value = cell.Value * -1
Else
cell.Value = cell.Value
End If

cell.NumberFormat = "General"

Next

End Sub

 

[OaklandJim]

Here is code that seems to do what you want.

Option Explicit


Sub Clean_Tally_Data(pwsWorkbook As Workbook)

    With pwsWorkbook
    
    End With

End Sub

' ----------------------------------------------------------------
' Procedure Name: ProcessFilesInSubFolders
' Purpose: Process files in sub folders found in a root folder.
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 6/10/2023
' ----------------------------------------------------------------

Sub ProcessFilesInSubFolders()

    Dim wbCurrent As Workbook

'   Name of of sub folder found.
    Dim sSubFolderFound As String
    
'   Path and file name for a file found in a sub folder.
    Dim sPathAndFileName As String

'   The root or starting folder to search within.
    Dim sPathRootFolder As String

'   Array holding names of sub folders found.
    Dim asSubFoldersFound() As String
    
'   Array holding names of files found in a sub folder.
    Dim asFilesFound() As String

'   Count and index used to iterate through sub folders found.
    Dim iSubFoldersFoundCount As Long
    Dim iSubFolder As Long

'   Count and index used to iterate through files found in a sub folder.
    Dim iFilesFoundCount As Long
    Dim iFileFound As Long

'   Enable user to select a folder.
    sPathRootFolder = GetFolderFromUser() & "\"
        
'   Tell user if there are no folders in the specified root folder.
    If Not FolderExists(sPathRootFolder) _
     Then
        MsgBox "The root folder does not exist." & Chr(10) & sPathRootFolder, vbInformation
        Exit Sub
    End If
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
      
'   Call function that loads sub folder names into the asFoldersFound array.
    Call GetFoldersInRoot(sPathRootFolder, asSubFoldersFound())

'   Get count of sub folders found.
    iSubFoldersFoundCount = 0
    
    On Error Resume Next
    iSubFoldersFoundCount = UBound(asSubFoldersFound())
    On Error GoTo 0
    
'   Tell user if there are no files in the specified root folder.
    If iSubFoldersFoundCount = 0 _
     Then
        MsgBox "No sub folders found in folder" & Chr(10) & sPathRootFolder & ".", vbInformation
        Exit Sub
    End If

'   Iterate through all sub folders found to process files.
    For iSubFolder = 1 To iSubFoldersFoundCount

'       Name of sub folder (not path)
        sSubFolderFound = asSubFoldersFound(iSubFolder)
        
'       Call function that loads the names of files in the sub folder being processed.
'       Only select Excel files
        Call GetFilesInFolder(sPathRootFolder & sSubFolderFound, asFilesFound(), "*xls*")

'       Count of files found in the sub folder.
        iFilesFoundCount = 0
        
        On Error Resume Next
        iFilesFoundCount = UBound(asFilesFound())
        On Error GoTo 0
        
        If iFilesFoundCount <> 0 _
         Then
'           Iterate through all files found in the sub folder.
            For iFileFound = 1 To iFilesFoundCount
        
'               Get full path and filename.
                sPathAndFileName = sPathRootFolder & sSubFolderFound & "\" & asFilesFound(iFileFound)
                        
'               Open workbook. Point wbCurrent object to the opened workbook.
                Set wbCurrent = Workbooks.Open(sPathAndFileName)
            
'               Call sub that modifies the file.
                Call Clean_Tally_Data(wbCurrent)
                
'               Close the current workbook.
                wbCurrent.Close
            
            Next iFileFound
        
        End If
        
    Next iSubFolder
    
End Sub


' ----------------------------------------------------------------
' Procedure Name: GetFoldersInRoot
' Purpose: Load array parameter with name(s) of folders in the specified "root" folder.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psPathRootFolder (String): Path to and name of "root" folder to look within.
' Parameter pasFilesFound (String): Array parameter filled with folder names found in the "root" folder.
' Return Type: String)
' Author: Jim
' Date: 6/10/2023
' ----------------------------------------------------------------

Function GetFoldersInRoot( _
    psPathRootFolder As String, _
    pasFoldersFound() As String)

'   Name of a folder found.
    Dim sFolderName As String

'   Used to keep track of how many folders are found in the root folder.
    Dim iFolderNum As Long

'   Get name of first sub folder in the root folder.
    sFolderName = Dir(psPathRootFolder & "\*", vbDirectory)

'   Process sub folders 2 through n where n is number of sub folders - 1
    Do While sFolderName <> ""

        If GetAttr(psPathRootFolder & "\" & sFolderName) And vbDirectory _
         Then

'           Screen out results one dot and two dots which Dir function returns.
            If Not sFolderName = "." And Not sFolderName = ".." _
             Then

'               Increment count of folders are found.
                iFolderNum = iFolderNum + 1

'               Resize the array parameter to accommodate the current sub folder found.
                ReDim Preserve pasFoldersFound(iFolderNum)

'               Put the naemof the folder into the array.
                pasFoldersFound(iFolderNum) = sFolderName

            End If

        End If

'       Get name of next folder, if any.
        sFolderName = Dir
    
    Loop

End Function

' ----------------------------------------------------------------
' Procedure Name: GetFilesInFolder
' Purpose: Load array parameter with name(s) of files in the specified folder.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psFolder (String): Path to and name of folder to process.
' Parameter pasFilesFound (String): Array parameter filled with file names found in the specified folder.
' Return Type: String)
' Author: Jim
' Date: 6/10/2023
' ----------------------------------------------------------------

Function GetFilesInFolder(psFolder As String, pasFilesFound() As String, Optional psScreen As String = "*")
    
'   Name of the file found.
    Dim sFileFound As String
    
'   Count of files found in the specified folder. Used to index names as they are found.
    Dim iFilesFound As Long
    
'   Get name of first file in the folder specified, if any.
    sFileFound = Dir(psFolder & "\" & psScreen)
    
'   Iterate until no more files are found.
    Do While sFileFound <> ""
        
'       Increment count of files found.
        iFilesFound = iFilesFound + 1
        
'       Resize the pasFilesFound array parameter to accommodate the name of the file found.
        ReDim Preserve pasFilesFound(iFilesFound)
        
'       Putname of file found into the array parameter.
        pasFilesFound(iFilesFound) = sFileFound
        
'       Get name of next file in the folder specified, if any.
        sFileFound = Dir
        
    Loop
    
End Function
'

' ----------------------------------------------------------------
' Procedure Name: FolderExists
' Purpose: Determine if a path => folder exists.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psPathAndFolder (String): Path and folder name.
' Return Type: Boolean
' Author: Jim
' Date: 6/11/2023
' ----------------------------------------------------------------
Function FolderExists(psPathAndFolder As String) As Boolean

    Dim sFolderExists As String
    
    FolderExists = False

    sFolderExists = Dir(psPathAndFolder, vbDirectory)

    If sFolderExists <> "" Then FolderExists = True

End Function