Module for implementation in multiple version-controlled spreadsheets

Question

So I maintain a large number of spreadsheets which are stored on a version-controlled server. In each spreadsheet maintained on this server there is a module containing the following code, which is intended to verify that the spreadsheet is the latest revision, opened from the server, and is locked to prevent inadvertent changes to formulas or fixed data.

I inherited a lot of this code from others who worked on it before me and I've made several major improvements (basically rewriting almost all of it). That said, I'm not a programmer (and neither were some of those who previously worked on this) and I'm not sure where I can make any further improvements.

Since the Security_Check subroutine runs every time a spreadsheet is opened, the faster it runs the better. Based on things I learned on StackOverflow, I use the Invisible/Unvisible subroutines to hide the window while the code is running to speed things up, turn off printcommunication while updating the header/footer, and I consolidated much of the code into reusable functions and subroutines to make it easier to maintain.

The code falls into three main sections:

• Security_Check, which verifies all the required conditions;
• SetStatus, to update the header and footer to show the status and message the user if there is a problem;
• miscellaneous support subs and functions.

Option Explicit
Option Compare Text
Option Private Module
Private Const sPass As String = "**<redacted>**"
Private Const bSignLine As Boolean = False
Sub Security_Check()
 Dim bDirectory As Boolean
 Dim bRevision As Boolean
 Dim bUpdate As Boolean
 Dim bListed As Boolean
 Dim bProtected As Boolean
 Dim rFind As Range
 Dim wsLoop As Worksheet
 Call Invisible
 Call OpenVL
 On Error GoTo ErrorCatch
 With Workbooks("VersionList.xls").Worksheets("V_List").Range("A:A")
 Set rFind = .Find(ThisWorkbook.CustomDocumentProperties.Item("MC_Number").Value, LookAt:=xlWhole)
 End With
 If Not rFind Is Nothing Then
 bListed = True
 If rFind.Offset(0, 1) = ThisWorkbook.CustomDocumentProperties.Item("MC_Revision").Value Then
 bRevision = True
 End If
 If rFind.Offset(0, 2) = ThisWorkbook.CustomDocumentProperties.Item("MC_CF_Update Number").Value Then
 bUpdate = True
 End If
 Call CloseVL
 Else
 bListed = False
 Call CloseVL
 Call SetStatus(False, "Spreadsheet not listed")
 Exit Sub
 End If
 If CheckPath(ThisWorkbook.Path) = True Then
 bDirectory = True
 End If
 If ThisWorkbook.ProtectStructure Then
 bProtected = True
 For Each wsLoop In ThisWorkbook.Worksheets
 If Not wsLoop.ProtectContents Then
 bProtected = False
 End If
 Next wsLoop
 End If
 If bListed = True And bDirectory = True And bRevision = True And bUpdate = True And bProtected = True Then
 Call SetStatus(True)
 Exit Sub
 ElseIf bDirectory = False Then
 Call SetStatus(False, "Not opened from server")
 Exit Sub
 ElseIf bRevision = False Then
 Call SetStatus(False, "Incorrect revision")
 Exit Sub
 ElseIf bUpdate = False Then
 Call SetStatus(False, "Incorrect update")
 Exit Sub
 ElseIf bProtected = False Then
 Call SetStatus(False, "Document not protected")
 Exit Sub
 End If
ErrorCatch:
 If bIsWBopen("VersionList.xls") Then
 Workbooks("VersionList.xls").Close
 End If
 Call SetStatus(False, "Status unverified")
 Call Unvisible
End Sub

---

Private Sub SetStatus(bStatus As Boolean, Optional sReason As String)
 Dim i As Integer
 Application.PrintCommunication = False
 For i = 1 To ThisWorkbook.Worksheets.Count
 With Worksheets(i).PageSetup
 .ScaleWithDocHeaderFooter = True
 .AlignMarginsHeaderFooter = True
 .LeftFooter = "&8" & ThisWorkbook.CustomDocumentProperties.Item("Server_Number").Value & " Rev. " & _
 ThisWorkbook.CustomDocumentProperties.Item("Server_Revision").Value & "." & _
 ThisWorkbook.CustomDocumentProperties.Item("Server_CF_Update Number").Value & chr(10) & _
 "Printed: " & Format(Now(), "dd mmm yyyy")
 If bSignLine = True Then
 .CenterFooterPicture.FileName = ThisWorkbook.CustomDocumentProperties.Item("Server_CF_Version List").Value & "Sign Line DO NOT MOVE.png"
 .CenterFooter = "&G&25" & chr(10)
 End If
 If bStatus = True Then
 .RightFooter = "&8" & ThisWorkbook.Path & chr(10) & "ONLINE"
 Else
 .RightFooter = "&8" & ThisWorkbook.Path & chr(10) & "OFFLINE" & ": " & sReason
 End If
 End With
 With Worksheets(i).Status_Text
 If bStatus = True Then
 .ForeColor = &HC000&
 .Caption = "ONLINE"
 Else
 .ForeColor = &HFF&
 .Caption = "OFFLINE"
 End If
 End With
 Next i
 Application.PrintCommunication = True
 If bStatus = False Then
 Call MsgBox("This validated spreadsheet is 'OFFLINE'." & chr(10) & chr(10) & _
 "Make sure that the spreadsheet was opened from server." & chr(10) & chr(10) & _
 "Contact <redacted> if the problem persists.", vbExclamation, "OFFLINE")
 End If
 Call Unvisible
End Sub

---

Private Function CheckPath(sDirectory As String)
 If sDirectory Like "*server/vault*" _
 Or sDirectory Like "*server_View*" _
 Or sDirectory Like "*company/main*" Then
 CheckPath = True
 Else
 CheckPath = False
 End If
End Function
Private Sub OpenVL()
 If bIsWBopen("VersionList.xls") = False Then
 Application.Workbooks.Open ThisWorkbook.CustomDocumentProperties.Item("Server_CF_Version List").Value & "VersionList.xls", ReadOnly:=True
 End If
End Sub
Private Sub CloseVL()
 If bIsWBopen("VersionList.xls") = True Then
 Workbooks("VersionList.xls").Close savechanges:=False
 End If
End Sub
Sub UnprotectBook()
 ThisWorkbook.Unprotect Password:=sPass
End Sub
Sub ProtectBook()
 ThisWorkbook.Protect Password:=sPass, Structure:=True
End Sub
Sub UnprotectSheets()
 Dim wsLoop As Worksheet
 For Each wsLoop In ThisWorkbook.Worksheets
 wsLoop.Unprotect Password:=sPass
 Next wsLoop
End Sub
Sub ProtectSheets()
 Dim wsLoop As Worksheet
 For Each wsLoop In ThisWorkbook.Worksheets
 wsLoop.Protect Password:=sPass, UserInterFaceOnly:=True
 wsLoop.EnableSelection = xlUnlockedCells
 Next
End Sub
Sub UnprotectSheet(wsUnprotect As Worksheet)
 wsUnprotect.Unprotect Password:=sPass
End Sub
Sub ProtectSheet(wsUnprotect As Worksheet)
 With wsUnprotect
 .Protect Password:=sPass, UserInterFaceOnly:=True
 .EnableSelection = xlUnlockedCells
 End With
End Sub
Sub Invisible()
 Application.Visible = False
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 Application.EnableEvents = False
End Sub
Sub Unvisible()
 Application.Visible = True
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
 Application.EnableEvents = True
End Sub
Function bIsWBopen(ByRef sWB As String) As Boolean
 On Error Resume Next
 bIsWBopen = Not (Application.Workbooks(sWB) Is Nothing)
End Function

Answer 1

Just things that jump out at me:

---

call is redundant.

SubName arg, arg, arg5:=arg
var = FunctionName(arg, arg, arg5:=arg)

Is clearer and less cluttered.

---

This:

If bListed = True And bDirectory = True And bRevision = True And bUpdate = True And bProtected = True Then
 Call SetStatus(True)
 Exit Sub
ElseIf bDirectory = False Then
 Call SetStatus(False, "Not opened from server")
 Exit Sub
ElseIf bRevision = False Then
 Call SetStatus(False, "Incorrect revision")
 Exit Sub
ElseIf bUpdate = False Then
 Call SetStatus(False, "Incorrect update")
 Exit Sub
ElseIf bProtected = False Then
 Call SetStatus(False, "Document not protected")
 Exit Sub
End If

Is trying to do too much. The only things inside an if block should be the things that will actually change. SetStatus is going to be run whatever the outcome so why not put just once, after the If block?

Dim passedTest as Boolean, errorMessage as string
passedTest = bListed And bDirectory And bRevision And bUpdate And bProtected 
If not passedTest Then
 If bDirectory = False Then errorMessage = errorMessage & " Not opened from server."
 If bRevision = False Then errorMessage = errorMessage & " Incorrect revision"
 If bUpdate = False Then errorMessage = errorMessage & " Incorrect update"
 If bProtected = False Then errorMessage = errorMessage & " Document not protected"
End If
SetStatus passedTest, errorMessage
End Sub

This also has the advantage that you can create more detailed error messages in the event that you have more than one problem.

Additionally, except in very rare circumstances, there should never be more than one Exit Sub in a procedure. One entrance, One Exit, anything else gets really messy really fast.

---

Hungarian notation which prefixes every variable with its' type is not useful in the majority of cases. Instead, variables should sound like what they are.

Which is clearer?

bDirectory, bRevision, bUpdate, bProtected

or

isFromCorrectDirectory, isCorrectRevision, isCorrectUpdate, isProtected

This then has the added bonus of code that reads very close to plain english:

passedTest = isFromCorrectDirectory and isCorrectRevision and isCorrectUpdate and isProtected

---

Integer is also redundant. Use Long instead.

---

SetStatus should be further refactored.

Something along the lines of:

Private Sub SetStatus(passedTest As Boolean, Optional errorMessage As String)
Dim ix as long, wb as workbook, ws as worksheet
Application.PrintCommunication = False
set wb = ThisWorkbook
For ix = 1 to wb.Worksheets.Count
 set ws = wb.Worksheets(ix)
 ApplyPageSetup ws, passedTest, errorMessage 
 ApplyStatusText ws, passedTest
Next ix
Application.PrintCommunication = True
If Not passedTest then 
 MsgBox "This validated spreadsheet is 'OFFLINE'." & chr(10) & chr(10) & _
 "Make sure that the spreadsheet was opened from server." & chr(10) & chr(10) & _
 "Contact <redacted> if the problem persists.", vbExclamation, "OFFLINE"
End IF
Unvisible
End Sub

• Toast: This worked great, but I did run into a few interesting errors. I created a ApplyStatusText subroutine, with arguments ws as Worksheet and isOnline as boolean. I've run into this problem before, here's a link to the solution that was found. The second issue is that Excel has a maximum character count in the footer, so if ErrorMessage got too long, it would crash when setting the left footer. I shortened the error messages to solve the problem.
• Toast: As a further note, I checked the time for this to run on a few existing spreadsheets. 1. Inherited code: 3.68099 seconds 2. Code from original question: 1.778646 seconds 3. Code with suggestions from @Zak 1.208333 seconds
• Kaz: That must be a lot of spreadsheets. I would suggest, since the strings don't change from worksheet to worksheet, calculate them once, before the loop, and then just reference that variable.
• Kaz: And just generally, if a program is running slower than you'd like, time each of the subroutines. Identify where the majority of the time is spent. Then time its' subroutines etc. Keep going until you find the source of your delay (in most cases, a few lines of code will count for a disproportionate amount of runtime) and try to figure out how to do it more efficiently. Repeat until it runs in an acceptable amount of time.
• RubberDuck: Relevant reading on why Zak said It's better to use Long instead of Integer.