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