Run a Version Checker using VBA

[RandyD123]

So I have a sheet named "Travel Orders" and I am trying to make it run against a version checker, but I am having issues with it. My code is as follows:

Option Explicit
Private Sub Workbook_Open()
    Dim WS As Worksheet
    For Each WS In ThisWorkbook.Sheets
    WS.Protect Password:="password", UserInterfaceOnly:=True
Next WS
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim WS As Worksheet
    Set WS = ActiveSheet
    If WS.Name = "Data" Then Exit Sub
    If Not Intersect(Target, Range("B5:M14")) Is Nothing Then
        Application.EnableEvents = False
        Sheets("Travel Orders").Unprotect Password:="password"
        WS.Range("M2") = Environ("Username")
        WS.Range("M3") = Now
        Sheets("Travel Orders").Protect Password:="password"
        Application.EnableEvents = True
    End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 Dim WS As Worksheet
 Set WS = ActiveSheet
     If WS.Name = "Travel Orders" Then Exit Sub
     Sheets("Data").Unprotect Password:="password"
     WS.Range("E10") = Environ("Username")
     WS.Range("E11") = Now
     Sheets("Data").Protect Password:="password"
 End Sub
Private Sub Workbook_Open()
    Sheets("Travel Orders").Activate
    On Error GoTo Error
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .StatusBar = "Checking Travel Orders Version.  Please wait..."
    End With
    Workbooks.Open "Path To Version Checker.xlsm", , True
    Workbooks("Travel Orders.xlsm").Activate
    If Workbooks("Travel Orders.xlsm").Sheets("Travel Orders").Range("M1").Value <> Workbooks("Version Checker.xlsm").Sheets("Version").Range("C3").Value Then
        Application.StatusBar = "You are running an old version of 'Travel Orders'.  Please download the newest version from iShare."
        MsgBox "You are running an old version of 'Travel Orders'.  Please download the newest version from iShare.", 16, "Wrong Version"
        Workbooks("Version Checker.xlsm").Close SaveChanges:=False
        With Application
            .EnableEvents = True
            .StatusBar = ""
        End With
        Workbooks("Travel Orders.xlsm").Close SaveChanges:=False
    End If
    Workbooks("Version Checker.xlsx").Close SaveChanges:=False
Cleanup:
    Range("B4").Select
    With Application
        .EnableEvents = True
        .StatusBar = ""
    End With
    Exit Sub
Error:
    MsgBox "Error #" & Err.Number & " has occurred." & vbNewLine & vbNewLine & Err.Description & vbNewLine & vbNewLine & "Please contact PERSON for assitance!", 16, "Error Occurred"
    Application.DisplayAlerts = False

    Application.DisplayAlerts = True
    Sheets("Travel Orders").Activate
    GoTo Cleanup
End Sub

I get the following error:

Not sure how to fix. And in the "error" part of the code I only really need an error msg box if something goes wrong. Any help would be much appreciated.

 

[Joe4]

That is because you pasted in the "End Sub" too.
You were supposed to just copy the body of the code, not the "End Sub".
There should be exactly one "End Sub" for every "Private Sub" line.
One is the start of a procedure, the other is the end.

I would also recommend that you put the smaller block of code at the top (like KOKSEK showed you), as the larger one has some error handling and other things that might not run correctly if not put at the end.

 

[RandyD123]

That is because you pasted in the "End Sub" too.
You were supposed to just copy the body of the code, not the "End Sub".
There should be exactly one "End Sub" for every "Private Sub" line.
One is the start of a procedure, the other is the end.

I would also recommend that you put the smaller block of code at the top (like KOKSEK showed you), as the larger one has some error handling and other things that might not run correctly if not put at the end.

Ok, I changed it to:

Option Explicit
Private Sub Workbook_Open()
Sheets("Travel Orders").Activate
    On Error GoTo Error
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .StatusBar = "Checking Travel Orders Version.  Please wait..."
    End With
    Workbooks.Open "https://path toVersion Checker.xlsm", , True
    Workbooks("Travel Orders.xlsm").Activate
    If Workbooks("Travel Orders.xlsm").Sheets("Travel Orders").Range("M1").Value <> Workbooks("Version Checker.xlsm").Sheets("Version").Range("C3").Value Then
        Application.StatusBar = "You are running an old version of 'Travel Orders'.  Please download the newest version from iShare."
        MsgBox "You are running an old version of 'Travel Orders'.  Please download the newest version from iShare.", 16, "Wrong Version"
        Workbooks("Version Checker.xlsm").Close SaveChanges:=False
        With Application
            .EnableEvents = True
            .StatusBar = ""
        End With
        Workbooks("Travel Orders.xlsm").Close SaveChanges:=False
    End If
    Workbooks("Version Checker.xlsm").Close SaveChanges:=False
Cleanup:
    Range("B4").Select
    With Application
        .EnableEvents = True
        .StatusBar = ""
Error:
    MsgBox "Error #" & Err.Number & " has occurred." & vbNewLine & vbNewLine & Err.Description & vbNewLine & vbNewLine & "Please contact PERSON for assitance!", 16, "Error Occurred"
    Application.DisplayAlerts = False

    Application.DisplayAlerts = True
    Sheets("Travel Orders").Activate
    GoTo Cleanup

    Dim WS As Worksheet
    For Each WS In ThisWorkbook.Sheets
    WS.Protect Password:="pass", UserInterfaceOnly:=True
Next WS

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim WS As Worksheet
    Set WS = ActiveSheet
    If WS.Name = "Data" Then Exit Sub
    If Not Intersect(Target, Range("B5:M14")) Is Nothing Then
        Application.EnableEvents = False
        Sheets("Travel Orders").Unprotect Password:="pass"
        WS.Range("M2") = Environ("Username")
        WS.Range("M3") = Now
        Sheets("Travel Orders").Protect Password:="pass"
        Application.EnableEvents = True
    End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 Dim WS As Worksheet
 Set WS = ActiveSheet
     If WS.Name = "Travel Orders" Then Exit Sub
     Sheets("Data").Unprotect Password:="pass"
     WS.Range("E10") = Environ("Username")
     WS.Range("E11") = Now
     Sheets("Data").Protect Password:="pass"
 End Sub

Still getting a compile error.

 

[Joe4]

Now you have no "End Sub" at the end of it, prior to the next "Private Sub".
Note that you CANNOT nest procedures inside one another. You must end one procedure before beginning the next.

I get the feeling that you don't have much experience with VBA.
If that is the case, I think you are going to be very frustrated trying to make changes to it.
VBA programming is an advanced skill with a bit of a learning curve.
I would highly recommend either picking up an introductory book to VBA or checking out some on-line tutorials/videos on it.