Error With Code Opening A Workbook

[charllie]

Hi Folks,

I am using the code below, which when run does the following:

• Opens workbook "Team Leader.xls" at specified location
  Goes to Worksheets("Team Leader Screen") in the workbook
  Carries out the functions in the with statement
  Save and closes the workbook "Team Leader.xls"

The above all works as required.

However i want to carry out the same above actions if the workbook already open. I thought that the code allowed for this but it appears that i have made a mistake.

If the workbook "Team Leader.xls" is open then the following happens:

• Goes to workbook "Team Leader.xls" at specified location
  Goes to Worksheets("Team Leader Screen") in the workbook
  Carries out the functions in the with statement
  A new pop up window appears asking if i would like to Save the workbook "Team Leader.xls"

Please could someone help me to identify where i am going wrong with the code and how i can get it to save automatically if the workbook is open.

In Short i want to perform the above actions if the workbook "Team Leader.xls" is either opened or closed.


Here is my code:

'*******Team Leader Screen***************
            'This code opens the Worksheets("Team Leader Screen")located
            'in Workbook "Team Leader.xls"
            Dim TLS As Worksheet
            Dim openflag As Boolean
            openflag = False
            
            For Each wb In Workbooks
            wbname = wb.Name
            If wbname = "Team Leader.xls" Then
                openflag = True  'Workbook "Team Leader.xls" was already open
                Windows(wbname).Activate
                GoTo 100
            End If
            Next wb
            
            Workbooks.Open Filename:="G:\Cwmbran-new\Warehouse\lean manu\Mike C\HandPack Time Sheet\On LIne\" & _
                             "Team Leader.xls"
100:
            
            Set TLS = Worksheets("Team Leader Screen") 'This refers to worksheet in other workbook
            
             With TLS
                 TLS.Range("G11") = TLS.Range("G8") 'Copies Completed Jobs to display in Team Leader Screen Previous Shift
                 TLS.Range("E11") = TLS.Range("E8") 'Copies Shift to display in Team Leader Screen Previous Shift
                 TLS.Range("E12") = TLS.Range("B28") 'Copies Total Discs Packed to display Team Leader Screen in Previous Shift
                 TLS.Range("E3") = ClearContents 'Team Leader
                 TLS.Range("E8") = ClearContents 'Shift
                 TLS.Range("G8") = ClearContents 'Completed Jobs
                 TLS.Range("B28") = ClearContents 'Total Discs
                 TLS.Range("H28") = ClearContents 'Total Quarantine Jobs
                 'TLS.ScreenListBox.Clear 'Empty the listbox
                 End With
        
            If openflag = False Then 'Then Workbook "Shift Manager.xls" was not open so close it
                Windows("Team Leader.xls").Close True  '** or change to False if you do not want to save any changes - you need to decide
            End If
            '*******End Of Team Leader Screen*******

Thanks

 

[al_b_cnu]

Hi charllie,

dont you want to test if openflag is false before opening the workbook, e.g.

if openflag=False then Workbooks.Open ....

 

[charllie]

Hi Alan,

How are you. Thanks for your reply.

I tried that and it appears to run a bit smoothly but it still asks me if i want to save the changes instaed of doing it automatically.

I have the workbook open in another pc and no changes are made to that.

Any ideas?

Thanks

Mike

 

[al_b_cnu]

Hi Mike,

try:

With Application
    .DisplayAlerts = False
    ActiveWorkbook.Close True
    .DisplayAlerts = True
End With

 

[charllie]

Hi Alan,

Thanks for that.

Tried that an below is my code as it is now.

I will try an explain better what my problem is.

• If i open:
  Workbook "Team Leader.xls" and
  Workbook "Shift Manager.xls" (This is one that contains this code)
  Both on my PC
  Then
  Use the commandbutton in "Shift Manager.xls" to run the code below
  it carries out the function without any issues.
  
  But if i open:
  Workbook "Team Leader.xls" on PC1
  and then open
  Workbook "Shift Manager.xls" (This is one that contains this code)
  on my PC
  Then
  Use the commandbutton in "Shift Manager.xls" to run the code below
  This time it opens up the "SAVE AS" windows and asks me if i want to save
  "Team Leader.xls".
  Therefore i then have two copies of "Team Leader.xls" open, one on my PC and one on PC1.
  Also it does not make any changes to the one open on PC1.

Not sure what i am doing wrong. I am sure your code will solve it but would appreciate it if you could check i have placed it correctly.

'*******Team Leader Screen***************
            'This code opens the Worksheets("Team Leader Screen")located
            'in Workbook "Team Leader.xls"
            Dim TLS As Worksheet
            Dim openflag As Boolean
            openflag = False
            
            For Each wb In Workbooks
            wbname = wb.Name
            If wbname = "Team Leader.xls" Then
                openflag = True  'Workbook "Team Leader.xls" was already open
                Windows(wbname).Activate
                GoTo 100
            End If
            Next wb
            If openflag = False Then
                Workbooks.Open Filename:="G:\Cwmbran-new\Warehouse\lean manu\Mike C\HandPack Time Sheet\On LIne\" & _
                                 "Team Leader.xls"
100:
                
                 Set TLS = Worksheets("Team Leader Screen") 'This refers to worksheet in other workbook
                
                 With TLS
                     TLS.Range("G11") = TLS.Range("G8") 'Copies Completed Jobs to display in Team Leader Screen Previous Shift
                     TLS.Range("E11") = TLS.Range("E8") 'Copies Shift to display in Team Leader Screen Previous Shift
                     TLS.Range("E12") = TLS.Range("B28") 'Copies Total Discs Packed to display Team Leader Screen in Previous Shift
                     TLS.Range("E3") = ClearContents 'Team Leader
                     TLS.Range("E8") = ClearContents 'Shift
                     TLS.Range("G8") = ClearContents 'Completed Jobs
                     TLS.Range("B28") = ClearContents 'Total Discs
                     TLS.Range("H28") = ClearContents 'Total Quarantine Jobs
                     'TLS.ScreenListBox.Clear 'Empty the listbox
                 End With
            End If
            With Application
                .DisplayAlerts = False
                'ActiveWorkbook.Close true
                .DisplayAlerts = True
            End With

            If openflag = False Then 'Then Workbook "Shift Manager.xls" was not open so close it
                Windows("Team Leader.xls").Close True  '** or change to False if you do not want to save any changes - you need to decide
            End If
            '*******End Of Team Leader Screen*******

Thanks

Mike

 

[al_b_cnu]

Hi mike,

Ah, didnt realise you were opening thre wbook on 2 PC's.

Firstly, I think this code is what you want - note I've removed the goto - I'm one of those 'purists' who doesnt like 'em :¬/

'*******Team Leader Screen***************
            'This code opens the Worksheets("Team Leader Screen")located
            'in Workbook "Team Leader.xls"
            Dim TLS As Worksheet
            Dim openflag As Boolean
            openflag = False
            
            For Each wb In Workbooks
                wbname = wb.Name
                If wbname = "Team Leader.xls" Then
                    openflag = True  'Workbook "Team Leader.xls" was already open
                    Windows(wbname).Activate
                    Exit For
                End If
            Next wb
            If openflag = False Then
                Workbooks.Open Filename:="G:\Cwmbran-new\Warehouse\lean manu\Mike C\HandPack Time Sheet\On LIne\" & _
                                 "Team Leader.xls"
            End If
                
             Set TLS = Worksheets("Team Leader Screen") 'This refers to worksheet in other workbook
            
             With TLS
                 TLS.Range("G11") = TLS.Range("G8") 'Copies Completed Jobs to display in Team Leader Screen Previous Shift
                 TLS.Range("E11") = TLS.Range("E8") 'Copies Shift to display in Team Leader Screen Previous Shift
                 TLS.Range("E12") = TLS.Range("B28") 'Copies Total Discs Packed to display Team Leader Screen in Previous Shift
                 TLS.Range("E3") = ClearContents 'Team Leader
                 TLS.Range("E8") = ClearContents 'Shift
                 TLS.Range("G8") = ClearContents 'Completed Jobs
                 TLS.Range("B28") = ClearContents 'Total Discs
                 TLS.Range("H28") = ClearContents 'Total Quarantine Jobs
                 'TLS.ScreenListBox.Clear 'Empty the listbox
             End With
            
            If openflag = False Then
                With Application
                    .DisplayAlerts = False
                    ActiveWorkbook.Close True
                    .DisplayAlerts = True
                End With
            End If
            '*******End Of Team Leader Screen*******

Have you just got a workbook on a shared drive, or have you also done Tools / Share Workbook on it?
I've not had much experience with shared workbooks, but the help is a good starter for 10.

 

[charllie]

Hi Alan,

Thanks for the code.

I will input it now and give it a try.

Have you just got a workbook on a shared drive, or have you also done Tools / Share Workbook on it?
I've not had much experience with shared workbooks, but the help is a good starter for 10.

The workbook is on a company shared drive so will have to take a look at it. It's new ground to me.

Thanks again.

Mike

 

[charllie]

Hi Alan,

Sorry for delay.

Tested your code but doesn't appear to be working. The code i am using is below although you will notice that i have changed the worksheet names etc.

When i run the code it all apppears to work, by that i mean it opens ("Shift Manager.xls") and closes it again.

But i am left with ("Shift Manager.xls") open in the other PC and no changes made to it.

I have set the shared workbook settings but it still doesnt seem to update. tried closing and reopening but no luck.

I am still trying various things so will keep you informed.

Thanks

Mike

'*******Shift Manager Screen********************************
'This code opens the Worksheets("Shift Managers Screen")located
'in Workbook "Shift Managers.xls"
For Each wb In Workbooks
wbname = wb.Name
If wbname = "Shift Manager.xls" Then
openflag = True 'Workbook "Shift Manager.xls" was already open
Windows(wbname).Activate
Exit For
End If
Next wb

If openflag = False Then
Workbooks.Open Filename:="G:\Cwmbran-new\Warehouse\lean manu\Mike C\HandPack Time Sheet\On LIne\" & _
"Shift Manager.xls" 'This opens the other workbook
End If

Set SMS = Worksheets("Shift Manager Screen") 'This refers to worksheet in other workbook
With SMS
SMS.Range("G13") = SMS.Range("G8") 'Copies Completed Jobs to display in Shift Managers Screen Previous Shift
SMS.Range("E13") = SMS.Range("F8") 'Copies Shift to display in Shift Managers Screen Previous Shift
SMS.Range("E14") = SMS.Range("D8") 'Copies Total Discs Packed to display Shift Managers Screen in Previous Shift
SMS.Range("E3") = ClearContents 'Team Leader
SMS.Range("D8") = ClearContents 'Total Discs
SMS.Range("F8") = ClearContents 'Shift
SMS.Range("G8") = ClearContents 'Total Jobs
SMS.Range("E10") = ClearContents 'Quarantine List
End With

'If openflag = False Then 'Then Workbook "Quarantine.xls" was not open so close it
'Windows("Shift Manager.xls").Close True '** or change to False if you do not want to save any changes - you need to decide
'End If
If openflag = False Then
With Application
.DisplayAlerts = True
ActiveWorkbook.Close True
.DisplayAlerts = True
End With
End If
'*******End Of Shift Manager Screen*************************