Check Version Against 2nd File

R

RandyD123

Active Member
Joined
Dec 4, 2013
Messages
296
Office Version
  1. 2016
Platform
  1. Windows
I have a file called Travel Orders which when opened checks another file called "FL_Version_Checker". If the version numbers match then the Travel Orders file stays open and can be used. If they do not match, the Travel Orders file closes and gives an error message. The problem is that the status bar keeps showing the message "Checking Travel Orders Version. Please Wait...." even if they match. I would like the status bar to update if they match and show a message that says "Version Match Please Continue" Not sure how to do that. My VB code is as follows:

VBA Code: 
Private Sub Workbook_Open()
    Sheets("Travel Orders").Activate
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .StatusBar = "Checking Travel Orders Version.  Please wait..."
    End With
    Workbooks.Open "https://path to/FL_Version_Checker.xlsm", , True
    Workbooks("Travel Orders.xlsm").Activate
    If Workbooks("Travel Orders.xlsm").Sheets("Travel Orders").Range("M1").Value <> Workbooks("FL_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("FL_Version_Checker.xlsm").Close SaveChanges:=False
        With Application
            .EnableEvents = True
            .StatusBar = ""
        End With
        Workbooks("Travel Orders.xlsm").Close SaveChanges:=False
    End If
    Workbooks("FL_Version_Checker.xlsm").Close SaveChanges:=False

End Sub

I'm not sure how to add the "Version Match Please Continue" part?
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Sort by date Sort by votes
Maybe something like this...
Code: 
Private Sub Workbook_Open()
    Sheets("Travel Orders").Activate
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .StatusBar = "Checking Travel Orders Version.  Please wait..."
    End With
    Workbooks.Open "https://path to/FL_Version_Checker.xlsm", , True
    Workbooks("Travel Orders.xlsm").Activate
    If Workbooks("Travel Orders.xlsm").Sheets("Travel Orders").Range("M1").Value <> Workbooks("FL_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("FL_Version_Checker.xlsm").Close SaveChanges:=False
        With Application
            .EnableEvents = True
            .StatusBar = ""
        End With
        Workbooks("Travel Orders.xlsm").Close SaveChanges:=False
    Else
    Application.StatusBar = "Version Match Please Continue"
    Application.Wait (Now + TimeValue("0:00:02"))
    End If
    Workbooks("FL_Version_Checker.xlsm").Close SaveChanges:=False
    Application.StatusBar = ""
End Sub
HTH. Dave
 
Upvote 0
That seems to work very well. So now I want to add the following code but when I do my M2 & M3 cells wont change. Not sure what I'm doing wrong? I understand that I can't have 2 Private Sub Workbook Open codes, but not sure where to put the below so it works? Your code alone works and my code alone works, but not all together!!

VBA Code: 
Option Explicit
Private Sub Workbook_Open()
    Dim WS As Worksheet
    For Each WS In ThisWorkbook.Sheets
    WS.Protect Password:="pass", 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:="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
 

Attachments

  • Capture.JPG
    Capture.JPG
    61.4 KB · Views: 11
Upvote 0
Not real sure what your trying to do? Is all of this code in the same wb? Seems like on workbook open, U want to check the version using the other wb, then password protect all sheets and then anytime during wb operation that a non "data" sheet is selected in the range Range("B5:M14") then enter username and time in the Travel orders sheet. Maybe U can clarify what it is that U want to do. Dave
 
Upvote 0
I'll try. The Data sheet is hidden and contains all the info for the drop down boxes. I'm trying to make sure that no user can alter M2 and M3. Those cells will record who makes a change to B5:M14. Just trying to make sure that the sheet gets locked on open and that even if they save a copy to their desktop, I will lock on open.
 
Upvote 0
This line needs the "WS."
Code: 
If Not Intersect(Target, WS.Range("B5:M14")) Is Nothing Then{/code]
combine wb open code...
[code]Else
    Application.StatusBar = "Version Match Please Continue"    
    Dim WS As Worksheet
    For Each WS In ThisWorkbook.Sheets
    WS.Protect Password:="pass", UserInterfaceOnly:=True
    Next WS
    Application.Wait (Now + TimeValue("0:00:02"))
 End If
Dave
 
Upvote 0
So I no matter what I try, I think that I'm not combining them right. Sorry but I don't get it?
 
Upvote 0
No apologies necessary. My somewhat cryptic reply didn't post correctly and was without much explanation. Add your Before Save code to this. Seems like it should work. Dave
Code: 
Private Sub Workbook_Open()
    Dim WS As Worksheet
    Sheets("Travel Orders").Activate
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .StatusBar = "Checking Travel Orders Version.  Please wait..."
    End With
    Workbooks.Open "https://path to/FL_Version_Checker.xlsm", , True
    Workbooks("Travel Orders.xlsm").Activate
    If Workbooks("Travel Orders.xlsm").Sheets("Travel Orders").Range("M1").Value <> Workbooks("FL_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("FL_Version_Checker.xlsm").Close SaveChanges:=False
        With Application
            .EnableEvents = True
            .StatusBar = ""
        End With
        Workbooks("Travel Orders.xlsm").Close SaveChanges:=False
    Else
    Application.StatusBar = "Version Match Please Continue"
    For Each WS In ThisWorkbook.Sheets
    WS.Protect Password:="pass", UserInterfaceOnly:=True
    Next WS
    Application.Wait (Now + TimeValue("0:00:02"))
    End If
    Workbooks("FL_Version_Checker.xlsm").Close SaveChanges:=False
    Application.StatusBar = ""
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, WS.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
 
Upvote 0
Solution
It seems that my only issue is that M2 and M3 wont change when the drop downs are used. And E10 and E11 wont change on the hidden data sheet when I update that sheet. I could always post the actual file if that would make it easier to help. I am using this code:

VBA Code: 
Private Sub Workbook_Open()
    Dim WS As Worksheet
    Sheets("Travel Orders").Activate
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .StatusBar = "Checking Travel Orders Version.  Please wait..."
    End With
    Workbooks.Open "https://Path To/FL_Version_Checker.xlsm", , True
    Workbooks("Travel Orders.xlsm").Activate
    If Workbooks("Travel Orders.xlsm").Sheets("Travel Orders").Range("M1").Value <> Workbooks("FL_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("FL_Version_Checker.xlsm").Close SaveChanges:=False
        With Application
            .EnableEvents = True
            .StatusBar = ""
        End With
        Workbooks("Travel Orders.xlsm").Close SaveChanges:=False
    Else
    Application.StatusBar = "Version Match Please Continue"
    For Each WS In ThisWorkbook.Sheets
    WS.Protect Password:="mhtcco", UserInterfaceOnly:=True
    Next WS
    Application.Wait (Now + TimeValue("0:00:02"))
    End If
    Workbooks("FL_Version_Checker.xlsm").Close SaveChanges:=False
    Application.StatusBar = ""
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, WS.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
 
Upvote 0
Posting your wb along with a clear outline of what your trying to achieve seems like it would be best. Dave
 
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
476
Artik
Artik
R
  • Question Question
Run a Version Checker using VBA
2
Replies
12
Views
1K
Joe4
Joe4
I
  • Question Question
Check if file extsts before continue
Replies
5
Views
439
ipbr21054
I
M
  • Question Question
Email file VBA - change attachment from excel to PDF?
Replies
2
Views
364
MOB
M
S
  • Solved
Gathering Data From Multiple Files in Same Folder in Particular Range
9 10 11
Replies
105
Views
2K
shah0101
S

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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