Macro works for one file, does not work for all files in the directory

[chris1979]

Hi
I have around 50 files in the directory. I want macro to open the files one by one and run the macro saved in all files. Below is the code I have.,.....it opens one file, runs the macro and closes. it does not open any files listed in the directory.

Please assist.



Sub OpenAndRunMacro()
Dim wb As Workbook
Dim folderPath As String
Dim filename As String

' Disable alerts to prevent pop-up windows
Application.DisplayAlerts = False

' Define the folder path
folderPath = "C:\Users\C.ABC\OneDrive - ABC\Current_Week\"

' Check if the folder exists
If Dir(folderPath, vbDirectory) <> "" Then
' Loop through each file in the folder
filename = Dir(folderPath & "*.xls*")
Do While filename <> ""
' Open the workbook
Set wb = Workbooks.Open(folderPath & filename)

' Run the macro if it exists
On Error Resume Next
Application.Run "'" & wb.Name & "'!CopyAndPasteStock"
On Error GoTo 0

' Close the workbook without saving changes
wb.Close False

' Get the next filename
filename = Dir
Loop
Else
MsgBox "Folder not found!"
End If

' Enable alerts back
Application.DisplayAlerts = True

MsgBox "Process completed."
End Sub

 

[Alex Blakenburg]

I am understanding this correctly, the macro only updates the workbook that it is opening and not the initiating workbook ?

 

[Alex Blakenburg]

I have only made minimal changes to your code, mainly just to make it clear which workbook that that it is working on.
This assumes all the working code is in the Initiating workbook (which can be referred to as ThisWorkbook)

Sub OpenAndRunMacro_3()
    Dim wb As Workbook
    Dim folderPath As String
    Dim fileName As String
    
    ' Disable alerts to prevent pop-up windows
    Application.DisplayAlerts = False
    
    ' Define the folder path
    folderPath = "C:\Users\ABC\OneDrive - ABC Ltd\Current_Week_WISR\"
    
    ' Check if the folder exists
    If Dir(folderPath, vbDirectory) <> "" Then
    ' Loop through each file in the folder
        fileName = Dir(folderPath & "*.xlsx")
        Do While fileName <> ""
            ' Open the workbook
            Set wb = Workbooks.Open(folderPath & fileName)
            
            ' Run the macro if it exists
            On Error Resume Next
            '
            Call CopyAndPasteStock(wb)
            On Error GoTo 0
            
            ' Save changes to the workbook
            wb.Save
            
            ' Close the workbook with saving changes
            wb.Close True
            
            ' Get the next filename
            fileName = Dir()
        Loop
        Else
            MsgBox "Folder not found!"
    End If
    
    ' Enable alerts back
    Application.DisplayAlerts = True
    
    MsgBox "Process completed."
End Sub


Sub CopyAndPasteStock(activeWb As Workbook)
'This vba will copy and paste the closing stock as opening stock for the upcoming week, delete the existing data, change the date in B1 to next Tuesday and protect the file
    
    Dim sourceRange As Range
    Dim destinationRange As Range
    Dim stockSheet As Worksheet
    Dim password As String
    
    Set stockSheet = activeWb.Worksheets("Stock")
    With stockSheet
        ' Set the source range (L4:L111)
        Set sourceRange = .Range("L4:L111")
        
        ' Set the destination range (C4:C111) in the "Stock" sheet
        Set destinationRange = .Range("C4:C111")
        
        ' Unprotect the workbook with the password "superstar"
        .Unprotect "superstar"
    End With
    
    ' Copy the data from the source range to the destination range
    sourceRange.Copy
    destinationRange.PasteSpecial xlPasteValues
    
    ' Set the ranges to be deleted (D4:J111 and L4:L111)
    With stockSheet
        .Range("D4:J111").ClearContents
        .Range("L4:L111").ClearContents
        .Range("P5:V5").ClearContents
        .Range("P6:U6").ClearContents
        .Range("P14:P15").ClearContents
        .Range("M4:M111").ClearContents
        .Range("P8:V8").ClearContents
    End With
    
    With stockSheet
        .Range("B1").Formula = "=IF(MOD(A2-1,7)>2,A2+2-MOD(A2-1,7)+7,A2+2-MOD(A2-1,7))"
        .Range("B1").Value = .Range("B1").Value
    End With
      
    ' Protect the workbook with the same password
    With stockSheet
        .Range("B1").Locked = True
        .Range("C4:C111").Locked = True
        .Protect "superstar"
    End With
    
End Sub

 

[chris1979]

@Alex Blakenburg - this macro works. Thank you very much

 

[Alex Blakenburg]

Thanks for letting us know. Glad we could help.