check Wb is open and copy data to it

[Jock]

Wb1, Sht2 has data in cols A-D. This data is copied to this location by code
daily when new cases are started on sht1 in the same Wb.
Once a week, I need the data from Sht2 to be copied to WB2, Sht3 by clicking
a button. Once data copied over to Wb2, Sht 3, the data on Wb1, Sht 2 to be
deleted.
The problem I am having is checking to see if Wb2 is open - I get the
'subscript out of range' error.
How do I check if a workbook is open (without getting a debug window), open
it if it is closed and show a message to that effect?

 

[Jacob Skaria]

Copy the below function and use it in your macro as shown in the below example

Sub Macro1()
If IsWorkbookOpen("book3.xls") Then
'place your code
End If

End Sub
Function IsWorkbookOpen(strWorkbook) As Boolean
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(strWorkbook)
If Not wb Is Nothing Then IsWorkbookOpen = True
End Function

 

[Jock]

Thanks Jacob.
I'm still getting the 'subscript out of range' error message (Run time error
9) on the Set wb = stage of the Function.
I have tried the full path to the file (which is on a network) with and
without the .xls extention with the same result.

 

[Jacob Skaria]

Why dont you post what you tried. When the workbook is open you dont need to
mention the full path..Just the workbook name as displayed in the caption.
The extension .xls or .xlsx depends whether the workbook is saved...I hope it
is saved and so you will need the extension...

Msgbox IsWorkbookOpen("filename.xls")

will return True/False ..

Paste the code in a fresh module and try. If you are still unable to...then
post the code which you are trying..

 

[Jock]

When the second Wb is open, no problems. If it is closed, however, then I get
the run time error.
I tried putting the full path in i.e. - IsWorkbookOpen ("S:\blah\blah\R of
C.xls").
Part of the code below.

Sub X_Fer() 'copies data

Dim Srng As Range
Dim Drng As Range
Dim DestWb As Workbooks
Dim DestSh As Worksheet
Dim SouSh As Worksheet
Dim SSh As Worksheet
Dim rng As Range



Set SSh = Workbooks("CMS").Worksheets("new") 'source worksheet

If IsWorkbookOpen("S:\blah\blah\R of C.xls") Then
Set DestSh = Workbooks("R of C").Worksheets("Register") 'destination worksheet
Else
Workbooks.Open ("S:\blah\blah\R of C.xls")

'more code here...

thanks.

 

[Jacob Skaria]

Try the below

Function IsWorkbookOpen(strWorkbook) As Boolean
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(strWorkbook)
If Not wb Is Nothing Then IsWorkbookOpen = True
End Function

Sub X_Fer() 'copies data

If IsWorkbookOpen("R of C.xls") Then
Set DestSh = Workbooks("R of C").Worksheets("Register")
Else
Workbooks.Open "S:\blah\blah\R of C.xls"
End If

End Sub

 

[Don Guillett]

This should activate if open or open if closed

Sub GetWorkbook()
workbookname = "wb2"
On Error GoTo OpenWorkbook
Windows(workbookname & ".xls").Activate
Exit Sub
OpenWorkbook:
Workbooks.Open(workbookname & ".xls").RunAutoMacros xlAutoOpen
End Sub

 

[Jock]

Hi Jacob, thanks for trying.
Even with new, empty modules I get the same run time error.
I'll just have to code a message box to appear if "R of C" isn't open and
get the users to do it manually

 

[Jacob Skaria]

I missed the extension in the previous post...

If IsWorkbookOpen("R of C.xls") Then
Set DestSh = Workbooks("R of C.xls").Worksheets("Register")
Else
Workbooks.Open "S:\blah\blah\R of C.xls"
End If

 

[Jock]

Guys. Regardless of what I do, when the second Wb is closed, I get run time
errors in:
Set wb = Workbooks(strWorkbook) (Jacob), and
Windows(workbookname & ".xls").Activate (Don)

When Wb is open, both work fine!
Thanks though.

 

[Don Guillett]

Workbook name is not matching? Leading/trailing space/no space/??
If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results.