Run a Version Checker using VBA

RandyD123

Active Member
Joined
Dec 4, 2013
Messages
289
Office Version
  1. 2016
Platform
  1. Windows
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:

VBA Code:
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:
Capture1.JPG


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.
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
You cannot have two different procedures with the same name in the same module (you have two "Workbook_Open" event procedures)!
You will need to combine these into a single procedure.
 
Upvote 0
You cannot have two different procedures with the same name in the same module (you have two "Workbook_Open" event procedures)!
You will need to combine these into a single procedure.
I thought so, but that's my problem, I don't know how to do that!!
 
Upvote 0
Remove first instance of Workbook_Open in full and move what's inside into second instance, like:

VBA Code:
Private Sub Workbook_Open()
'
'part from 1 workbook_open
'
Dim WS As Worksheet
For Each WS In ThisWorkbook.Sheets
    WS.Protect Password:="password", UserInterfaceOnly:=True
Next WS
'
'original part of 2nd 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
etc.......
 
Upvote 0
Remove first instance of Workbook_Open in full and move what's inside into second instance, like:

VBA Code:
Private Sub Workbook_Open()
'
'part from 1 workbook_open
'
Dim WS As Worksheet
For Each WS In ThisWorkbook.Sheets
    WS.Protect Password:="password", UserInterfaceOnly:=True
Next WS
'
'original part of 2nd 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
etc.......
Sorry not sure what that means or how to do it...
 
Upvote 0
So I've changed my code a bit but it still won't run. Not sure what a want "clean up" to be, and I'm not sure I need the "error" part of it.

VBA Code:
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 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.xlsm").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"
    Sheets("Travel Orders").Activate
    GoTo Cleanup
End Sub
 
Upvote 0
Sorry not sure what that means or how to do it...
OK, let's simplify this.
You can see that you have two different procedures with the exact same name right? That is not allowed (otherwise it wouldn't know which one to run when you try to call it).
Let's make it real simple and call everything in the first one "Code Block1" and everything in the second one called "Code Block2".

So, the simplified structure of the two procedures looks like this:
Rich (BB code):
Private Sub Workbook_Open()

'   Code Block1

End Sub


Private Sub Workbook_Open()

'   Code Block2

End Sub

So all you have to do is to move one of the code blocks to the other procedure, and delete the shell of the one you removed the block from, so you should be left with this structure:
Rich (BB code):
Private Sub Workbook_Open()

'   Code Block1

'   Code Block2

End Sub
 
Upvote 0
OK, let's simplify this.
You can see that you have two different procedures with the exact same name right? That is not allowed (otherwise it wouldn't know which one to run when you try to call it).
Let's make it real simple and call everything in the first one "Code Block1" and everything in the second one called "Code Block2".

So, the simplified structure of the two procedures looks like this:
Rich (BB code):
Private Sub Workbook_Open()

'   Code Block1

End Sub


Private Sub Workbook_Open()

'   Code Block2

End Sub

So all you have to do is to move one of the code blocks to the other procedure, and delete the shell of the one you removed the block from, so you should be left with this structure:
Rich (BB code):
Private Sub Workbook_Open()

'   Code Block1

'   Code Block2

End Sub
Ok, got it, but it doesn't much matter, I can't get my version checker code to work properly anyway!!!
 
Upvote 0
Ok, got it, but it doesn't much matter, I can't get my version checker code to work properly anyway!!!
Well, you cannot do anything to check it until you take care of that error first.
That will prevent any code in either of those two procedures from even attempting to run.

Once you get rid of the errors, then you can debug the code.
Stepping into your code and going through it line-by-line is a good way to see what is going on.
Often time, if you do this and watch what is happening on the worksheets, the problem becomes evident (you can see if it abends early, or takes an unexpected path).
 
Upvote 0
Ok, so I did this but I get a compile error.
VBA Code:
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 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.xlsm").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"
    Sheets("Travel Orders").Activate
    GoTo Cleanup
End Sub

    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
 
Upvote 0

Forum statistics

Threads
1,213,549
Messages
6,114,264
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top