Run a Version Checker using VBA

R

RandyD123

Active Member
Joined
Dec 4, 2013
Messages
296
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

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
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
Joe4 said:
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.
Click to expand...
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
KOKOSEK said:
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.......
Click to expand...
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
RandyD123 said:
Sorry not sure what that means or how to do it...
Click to expand...
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
Joe4 said:
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
Click to expand...
Ok, got it, but it doesn't much matter, I can't get my version checker code to work properly anyway!!!
 
Upvote 0
RandyD123 said:
Ok, got it, but it doesn't much matter, I can't get my version checker code to work properly anyway!!!
Click to expand...
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
You must log in or register to reply here.

Similar threads

T
  • Solved
Kill Command should work according to everything I have read, but it doesn't
Replies
6
Views
431
Artik
Artik
C
  • Question Question
If User Selects Cancel All Sheets are Unprotected
Replies
4
Views
131
christianbiker
C
L
  • Question Question
VBA - Run time error '9': subscript out of range
Replies
3
Views
182
RoryA
RoryA
Ottsel
  • Question Question
Create & Secure PDFS with Excel
Replies
3
Views
186
John_w
J
M
  • Question Question
Not running code
Replies
0
Views
207
MagicCarpet
M

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

Share this page

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