VBA to Update a Named Range Value and CALL a Macro from another File in a Folder

[Johnny Thunder]

Hello All,

Here is a VBA batch project I am working on.


I have 45 .Xlsm files

• Each have a Macro to Unlock the file Unlock_File
• Each have a named Range QtrComment which equals a quarter and date "Q3 2014"
•Each have a Macro that Locks the file back down and Saves the File Lock_File

The procedure I am trying to accomplish is to open a Master file that contains a Macro that will look to a specific Folder location: U:\Business Files\Q32014\Johnny and open each file one by one and,

1. Call the Macro Unlock_File to unlock the file
2. Update Named Range on Sheet "Cover Letter" QtrComment from "Q3 2014" to "Q4 2014"
3. Call Macro Lock_File to lock down the file and save

The code will need to be a loop so that it can run on all files in this folder location. Not really sure where to start, I have ran the Macro recorder and got more confused.

Thanks for any help in advance.

Currently on Excel 2013 (64-Bit)

 

[JoeMo]

This is untested. If your range name is not global then qualify it with the sheet name like this:
Sheets("Cover Letter").Range("QtrComment")

Sub JohnnyUpdate()
Dim pStr As String, myFile As String, Ct As Long
pStr = "U:\Business Files\Q32014\Johnny" & Application.PathSeparator
myFile = Dir(pStr & "*.xlsm")
Application.ScreenUpdating = False
If myFile = vbNullString Then
    MsgBox "Can't find any files in folder with .xlsm file extensions"
    Exit Sub
ElseIf Not WorkbookOpen(myFile) Then
    Workbooks.Open Filename:=pStr & myFile
Else
    Workbooks(myFile).Activate
End If
Call unlock_file
On Error Resume Next
'next line assumes named range has workbook-level scope
Range("QtrComment").Value = "Q4 2014"
On Error GoTo 0
Call lock_file
ActiveWorkbook.Close savechanges:=True
Ct = 1
Do
    myFile = Dir()
    If myFile = vbNullString Then Exit Do
    If Not WorkbookOpen(myFile) Then
        Workbooks.Open Filename:=pStr & myFile
    Else
        Workbooks(myFile).Activate
    End If
    Call unlock_file
    On Error Resume Next
    'next line assumes named range has workbook-level scope
    Range("QtrComment").Value = "Q4 2014"
    On Error GoTo 0
    Call lock_file
    ActiveWorkbook.Close savechanges:=True
    Ct = Ct + 1
Loop
MsgBox "Update completed on " & Ct & " workbooks"
End Sub
Function WorkbookOpen(WorkBookName As String) As Boolean
    WorkbookOpen = False
    On Error GoTo WorkBookNotOpen
    If Len(Application.Workbooks(WorkBookName).Name) > 0 Then
        WorkbookOpen = True
        Exit Function
    End If
WorkBookNotOpen:
End Function

 

[Johnny Thunder]

Joe,

Thank you for all the help on this project. So, with the code you gave me as a great starter, it got me thinking about the solution. Unfortunately, the CALL UnLock_File line is resulting in an error. I have tried a few different variations of the "Calling a macro from another workbook" code such as Application.Run and this too doesn't work for me so I added the function your code and now it is working. Problem is, the macro has a very long lag and does not loop to other files in the folder, just keeps opening the same file and trying to apply the update and then saving?

Sub JohnnyUpdate()
Dim pStr As String, myFile As String, Ct As Long
pStr = "U:\Business Files\Q32014\Johnny" & Application.PathSeparator
myFile = Dir(pStr & "*.xlsm")
Application.ScreenUpdating = False
If myFile = vbNullString Then
    MsgBox "Can't find any files in folder with .xlsm file extensions"
    Exit Sub
ElseIf Not WorkbookOpen(myFile) Then
    Workbooks.Open Filename:=pStr & myFile
Else
    Workbooks(myFile).Activate
End If

Unlock_File

On Error Resume Next
'next line assumes named range has workbook-level scope
Sheets("Cover Letter").Range("QtrComment").Value = "Q4 2014"
On Error GoTo 0

Lock_File

ActiveWorkbook.Close savechanges:=True
Ct = 1
Do
    myFile = Dir(pStr & "*.xlsm")
    If myFile = vbNullString Then Exit Do
    If Not WorkbookOpen(myFile) Then
        Workbooks.Open Filename:=pStr & myFile
    Else
        Workbooks(myFile).Activate
    End If
    Unlock_File
    
    On Error Resume Next
    'next line assumes named range has workbook-level scope
    Sheets("Cover Letter").Range("QtrComment").Value = "Q4 2014"
    On Error GoTo 0
    
    Lock_File
    
    ActiveWorkbook.Close savechanges:=True
    Ct = Ct + 1
Loop
MsgBox "Update completed on " & Ct & " workbooks"
End Sub
Function WorkbookOpen(WorkBookName As String) As Boolean
    WorkbookOpen = False
    On Error GoTo WorkBookNotOpen
    If Len(Application.Workbooks(WorkBookName).Name) > 0 Then
        WorkbookOpen = True
        Exit Function
    End If
WorkBookNotOpen:
End Function
Function Unlock_File()

 Dim ws As Worksheet
 Dim passRange As Range
 Dim password As String

 Set passRange = Range("QtrEnd")
 password = "rgblte" & Format(passRange.Value, "YYMMDD")

For Each ws In Worksheets
    ws.Unprotect password:=password
Next ws


End Function

Function Lock_File()

 Dim ws As Worksheet
 Dim passRange As Range
 Dim password As String

 Set passRange = Range("QtrEnd")
 password = "rgblte" & Format(passRange.Value, "YYMMDD")

For Each ws In Worksheets
    ws.Protect password:=password
Next ws

End Function

 

[JoeMo]

Joe,

Thank you for all the help on this project. So, with the code you gave me as a great starter, it got me thinking about the solution. Unfortunately, the CALL UnLock_File line is resulting in an error. I have tried a few different variations of the "Calling a macro from another workbook" code such as Application.Run and this too doesn't work for me so I added the function your code and now it is working. Problem is, the macro has a very long lag and does not loop to other files in the folder, just keeps opening the same file and trying to apply the update and then saving?

Sub JohnnyUpdate()
Dim pStr As String, myFile As String, Ct As Long
pStr = "U:\Business Files\Q32014\Johnny" & Application.PathSeparator
myFile = Dir(pStr & "*.xlsm")
Application.ScreenUpdating = False
If myFile = vbNullString Then
    MsgBox "Can't find any files in folder with .xlsm file extensions"
    Exit Sub
ElseIf Not WorkbookOpen(myFile) Then
    Workbooks.Open Filename:=pStr & myFile
Else
    Workbooks(myFile).Activate
End If

Unlock_File

On Error Resume Next
'next line assumes named range has workbook-level scope
Sheets("Cover Letter").Range("QtrComment").Value = "Q4 2014"
On Error GoTo 0

Lock_File

ActiveWorkbook.Close savechanges:=True
Ct = 1
Do
    myFile = Dir(pStr & "*.xlsm")
    If myFile = vbNullString Then Exit Do
    If Not WorkbookOpen(myFile) Then
        Workbooks.Open Filename:=pStr & myFile
    Else
        Workbooks(myFile).Activate
    End If
    Unlock_File
    
    On Error Resume Next
    'next line assumes named range has workbook-level scope
    Sheets("Cover Letter").Range("QtrComment").Value = "Q4 2014"
    On Error GoTo 0
    
    Lock_File
    
    ActiveWorkbook.Close savechanges:=True
    Ct = Ct + 1
Loop
MsgBox "Update completed on " & Ct & " workbooks"
End Sub
Function WorkbookOpen(WorkBookName As String) As Boolean
    WorkbookOpen = False
    On Error GoTo WorkBookNotOpen
    If Len(Application.Workbooks(WorkBookName).Name) > 0 Then
        WorkbookOpen = True
        Exit Function
    End If
WorkBookNotOpen:
End Function
Function Unlock_File()

 Dim ws As Worksheet
 Dim passRange As Range
 Dim password As String

 Set passRange = Range("QtrEnd")
 password = "rgblte" & Format(passRange.Value, "YYMMDD")

For Each ws In Worksheets
    ws.Unprotect password:=password
Next ws


End Function

Function Lock_File()

 Dim ws As Worksheet
 Dim passRange As Range
 Dim password As String

 Set passRange = Range("QtrEnd")
 password = "rgblte" & Format(passRange.Value, "YYMMDD")

For Each ws In Worksheets
    ws.Protect password:=password
Next ws

End Function

You altered a piece of the code I posted. Remove the bit in red font above after the Do line. It should read: myFile = Dir()

The change you made is causing the code to open the same workbook repeatedly.

 

[Johnny Thunder]

Thank you, and my bad, I should have left that piece alone.

Code worked like a charm. You are the man!

 

[JoeMo]

Thank you, and my bad, I should have left that piece alone.

Code worked like a charm. You are the man!

Or at least give the responder a heads-up that you made some changes . You are welcome and thanks for the reply.