Help With WorkBook Open/Close Problem

[charllie]

Hi Folks,

I am using the following code in a workbook which when activated does the following:

• Opens the workbook "Shift Manager.xls" located in various folders in my G:Drive.
  Locates the worksheet "Shift Manager Screen" in the workbook
  Then performs the code which is in the with statement of the code below
  Then saves and closes the workbook "Shift Manager.xls"

My problem is that this code only works if the workbook "Shift Manager.xls" is closed. However the workbook will be open at all times.
Is there a way of performing this action with the workbook open.

I did think about placing a duplicate copy of the worksheet "Shift Manager Screen" in an archive workbook which will always be closed. Then get the workbook "Shift Manager.xls" to update from this archive folder by refreshing itself every so often. But i am not sure if that will work and how to do it. Also the information that it will need to update will mean that it will have to add up 1 row at a time for all new rows enter.

Can anyone help me to overcome this problem with a solution.

Application.ScreenUpdating = False
        Dim SMS As Worksheet
            
            Workbooks.Open Filename:="G:\Cwmbran-new\Warehouse\lean manu\Mike C\HandPack Time Sheet\On LIne\" & _
                             "Shift Manager.xls" 'This opens the other workbook

        Set SMS = Worksheets("Shift Manager Screen") 'This refers to worksheet in other workbook
        
        With SMS
            .Range("G8").Value = Val(.Range("G8").Value) + 1 & " Jobs Completed" 'Running Total Of Total Jobs Completed
            .Range("D8").Value = Val(.Range("D8").Value) + Val(Me.TotalDiscsTextBox.Value) & " Total Discs Packed" 'Running Total Of Total Discs Packed
        End With
        ActiveWorkbook.Save                'Saves changes in the other workbook
        ActiveWorkbook.Close               'Closes the other workbook
    Application.ScreenUpdating = True

Thanks

 

[pcc]

see if it's open first:

For Each wb In Workbooks
wbname = wb.Name
If wbname = "Shift Manager.xls" Then
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\" & _ 
                             "Shift Manager.xls" 
100:

 

[BrianB]

1. You need a method of stopping a fatal error occurring if the workbook is already open.
2. When we use more than one workbook it is necessary to be explicit about which one we use.

Here are a couple of adjustments to your code. You will need to replace 'book1.xls' with your workbook name.

' partial code
    '---------------------------------------------------
    '- trap the error if the workbook is open
    On Error Resume Next
    Workbooks.Open FileName:="G:\Cwmbran-new\Warehouse\lean manu\Mike C\HandPack Time Sheet\On LIne\" & _
                     "Shift Manager.xls" 'This opens the other workbook
    On Error GoTo 0
    '---------------------------------------------------
    Set SMS = Workbooks("Book1.xls").Worksheets("Shift Manager Screen")

 

[charllie]

Hi Both,

Thankyou very much for your replies. Much appreciated.

I have amended my code and a copy is below. However i am still getting a message box appearing telling me that "Shift Manager.xls is already open reopening will cause me to loose information etc"

If i choose "NO" on this message box then it carries out the function as required but closes my workbook that i have the code in. I assume that i need to remove this part to stop the book closing.

ActiveWorkbook.Save                'Saves changes in the other workbook
ActiveWorkbook.Close               'Closes the other workbook

Can you see what i am doing wrong, have i placed something in the wrong position?

Application.ScreenUpdating = False
        Dim SMS As Worksheet
            
        '- trap the error if the workbook is open
        On Error Resume Next
                Workbooks.Open Filename:="G:\Cwmbran-new\Warehouse\lean manu\Mike C\HandPack Time Sheet\On LIne\" & _
                                 "Shift Manager.xls" 'This opens the other workbook
        On Error GoTo 0
        
        Set SMS = Workbooks("Shift Manager.xls").Worksheets("Shift Manager Screen")
        
        With SMS
            .Range("G8").Value = Val(.Range("G8").Value) + 1 & " Jobs Completed" 'Running Total Of Total Jobs Completed
            .Range("D8").Value = Val(.Range("D8").Value) + Val(Me.TotalDiscsTextBox.Value) & " Total Discs Packed" 'Running Total Of Total Discs Packed
        End With
        ActiveWorkbook.Save                'Saves changes in the other workbook
        ActiveWorkbook.Close               'Closes the other workbook
    Application.ScreenUpdating = True

 

[pcc]

did you try my method .

 

[charllie]

Hi PCC,

Yes i did try your code. i got two test workbooks running, however i couldn't get it to work.

Finally managed to get it running now, my fault put code in wrong place. Anyway its working as required but i get a fault with this line of code.

Sheets("Team Leader Screen").Select

I need to include this line of code because without it the it takes me to the Worksheets("Shift Manager Screen") and shows this on my screen when the code has finished.

Any suggestions how to return to Sheets("Team Leader Screen").Select?

Heres my code as it is now with yours included:

Application.ScreenUpdating = False
        Dim SMS As Worksheet
        
        
        For Each wb In Workbooks
        wbname = wb.Name
        If wbname = "Shift Manager.xls" Then
            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\" & _
                             "Shift Manager.xls"
100:

        Set SMS = Worksheets("Shift Manager Screen") 'This refers to worksheet in other workbook
        
        With SMS
            .Range("G8").Value = Val(.Range("G8").Value) + 1 & " Jobs Completed" 'Running Total Of Total Jobs Completed
            .Range("D8").Value = Val(.Range("D8").Value) + Val(Me.TotalDiscsTextBox.Value) & " Total Discs Packed" 'Running Total Of Total Discs Packed
        End With
        'ActiveWorkbook.Save                'Saves changes in the other workbook
        'ActiveWorkbook.Close               'Closes the other workbook
    Application.ScreenUpdating = True

By the way, nice part of the country, i lived in Castle Donnington for a few years.

Thanks

 

[pcc]

put these 2 lines just before turning screenupdating back on

Windows("Shift Manager.xls").Activate
Sheets("Team Leader Screen").Activate

 

[charllie]

Hi pcc,

That worked brilliantly.

Everything seems to be working as required now.

Thanks for all your help.

 

[charllie]

Hi PCC,

Just had an after thought.

Is there anything i could add to my finished code (below) to make it work incase the workbook happens to be closed, so that it will save close and workbook.

Thanks

 

[charllie]

Opps,

Forgot to add code in last post:

Application.ScreenUpdating = False
        Dim SMS As Worksheet
        
        For Each wb In Workbooks
        wbname = wb.Name
        If wbname = "Shift Manager.xls" Then
            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\" & _
                             "Shift Manager.xls"
100:

        Set SMS = Worksheets("Shift Manager Screen") 'This refers to worksheet in other workbook
        
        With SMS
            .Range("G8").Value = Val(.Range("G8").Value) + 1 & " Jobs Completed" 'Running Total Of Total Jobs Completed
            .Range("D8").Value = Val(.Range("D8").Value) + Val(Me.TotalDiscsTextBox.Value) & " Total Discs Packed" 'Running Total Of Total Discs Packed
        End With
        'ActiveWorkbook.Save                'Saves changes in the other workbook
        'ActiveWorkbook.Close               'Closes the other workbook
        
        '*******************************************************************
        'In this code place the name of worksheet you want to leave showiing
        'on the screen place the name of workbook it is in
        Windows("Team Leader - TEST.xls").Activate
        Sheets("Team Leader Screen").Activate
        '*******************************************************************
        
    Application.ScreenUpdating = True