Check to see if 2 workbooks open and if yes exit sub

creativespace · May 4th 2013

Hi All, I was hoping someone might be able to help with the following issue. I enter info into workbook1 and then run a macro to update workbook2 and workbook3. The code below works fine in terms of the updating but I am struggling to find a way to handle the problems if workbook2 or workbook3 is open.

I was hoping to check if workbook2 or workbook3 is open and then simply exit the sub. Thank you in anticipation of any help that can be provided. Best regards, Jay.

Code

Private Sub Update_Click()
On Error GoTo ErrHandler
Application.ScreenUpdating = False
'Confirmation of update response box
Dim Response As VbMsgBoxResult
Response = MsgBox("Confirm you want to write this information to the relevant workbook!", vbYesNo, "Are you sure?")
If Response = vbNo Then Exit Sub
Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
Dim wb2Paste As Range, wb3Paste As Range
On Error Resume Next
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open(Filename:="C:\Users\Desktop\Workbook 2.xls")
Set wb3 = Workbooks.Open(Filename:="C:\Users\Desktop\Workbook 3.xlsx")


If wb2.ReadOnly Then
MsgBox "Workbook 2 is already open. Please Try later!", vbCritical, "Workbook Open"
Exit Sub
End If
If wb3.ReadOnly Then
MsgBox "Workbook 3 is already open. Please Try later!", vbCritical, "Workbook Open"
Exit Sub
End If
 
With wb2.Sheets(2)
Set wb2Paste = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
'Copy Data from Wb1.Sheet1 to Wb2.sheet1
wb1.Sheets(1).Range("A8:I38").Copy
wb2Paste.PasteSpecial Paste:=xlValues, Transpose:=False
Application.CutCopyMode = False
Set wb2Paste = Nothing
wb2.Close SaveChanges:=True
wb1.Sheets(1).Range("A8:I38").ClearContents
With wb3.Sheets(1)
Set wb3Paste = .Range("A985")
End With
'Copy Data from Wb1.Sheet2 to Wb3.sheet1
wb1.Sheets(2).Range("A8:L497").Copy
wb3Paste.PasteSpecial Paste:=xlValues, Transpose:=False
Application.CutCopyMode = False
Set wb3Paste = Nothing
wb3.Close SaveChanges:=True
wb1.Save
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "An error has occurred. If the problem persists use the email button on the home page to report the issue!", vbOKOnly + vbCritical, "Error Message"


End Sub

Display More

patel · May 5th 2013

Re: Check to see if 2 workbooks open and if yes exit sub

Code

Sub Sample()
    Ret = IsWorkBookOpen("C:\Users\Desktop\Workbook 2.xls")
    If Ret = True Then
        MsgBox "File is open"
    Else
        MsgBox "File is Closed"
    End If
End Sub




Function IsWorkBookOpen(FileName As String)
    Dim ff As Long, ErrNo As Long


    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0


    Select Case ErrNo
    Case 0:    IsWorkBookOpen = False
    Case 70:   IsWorkBookOpen = True
    Case Else: Error ErrNo
    End Select
End Function

Display More

shorter

Code

Sub Sample1()
    Ret = BookOpen("Workbook 2.xls")
    If Ret = True Then
        MsgBox "File is open"
    Else
        MsgBox "File is Closed"
    End If
End Sub


Function BookOpen(wbName As String) As Boolean
On Error Resume Next
BookOpen = Len(Workbooks(wbName).Name)
End Function

Display More

HaHoBe · May 5th 2013

Re: Check to see if 2 workbooks open and if yes exit sub

Hi, Jay,

why exit the sub? In use by you or any other user? If by you/user in the same instance you may like to try

Code

Set wb1 = ThisWorkbook
    For Each wb In Workbooks
      Select Case wb.Name
        Case "Workbook 2.xls"
          Set wb2 = wb
        Case "Workbook 3.xlsx"
          Set wb3 = wb
      End Select
    Next wb
    If wb2 Is Nothing Then wb2 = Workbooks.Open(Filename:="C:\Users\Desktop\Workbook 2.xls")
    If wb3 Is Nothing Then wb3 = Workbooks.Open(Filename:="C:\Users\Desktop\Workbook 3.xlsx")

Display More

Ciao,
Holger

snb · May 5th 2013

Re: Check to see if 2 workbooks open and if yes exit sub

Keep it simple

Code

sub M_snb()
    If Not Evaluate("isref('[workbooks2.xls]sheet1'!A1)") Then Workbooks.Open "C:\Users\Desktop\Workbooks2.xls"
    If Not Evaluate("isref('[workbooks3.xlsx]sheet1'!A1)") Then Workbooks.Open "C:\Users\Desktop\Workbooks3.xlsx"
End Sub

creativespace · May 5th 2013

Re: Check to see if 2 workbooks open and if yes exit sub

Hi Gents... Patel, HaHoBe & snb, thanks very much for taking the time to reply, I really appreciate the help.
HaHoBe, I wanted to exit the sub because I am trying to write info to other workbooks and there is a chance that another user may have them open. I am a vba amateur so be gentle

I have had a good play today with examples you all provided but snb's example was the only one I was able to manipulate to do as I wanted, probably down to lack of skill, ha. It isn't pretty but it seems to do what is required. Below is the finished macro that updates workbooks 2 & 3 with info from workbook 1. If either workbook 2 or 3 is already open then the user gets an alert.

Again, thank you all for your help.. Ozgrid rules, Jay

Code

Private Sub Update_Click()
On Error GoTo ErrHandler
Application.ScreenUpdating = False
'Confirmation of update response box
Dim Response As VbMsgBoxResult
Response = MsgBox("Confirm you want to write this information to the relevant workbook!", vbYesNo, "Are you sure?")
If Response = vbNo Then Exit Sub
Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
Dim wb2Paste As Range, wb3Paste As Range
Set wb1 = ThisWorkbook
'the sheet ref cannot ref to a cell with a non-numeric value
If Evaluate("isref('[Workbook2.xlsx]sheet1'!A1)") Then
MsgBox "One of the destination workbooks is already open. Please close it and try again!"
Exit Sub
End If
'the sheet ref cannot ref to a cell with a non-numeric value
If Evaluate("isref('[Workbook3.xlsx]sheet2'!A1)") Then
MsgBox "One of the destination workbooks is already open. Please close the destination workbooks and try again!"
Exit Sub
End If


Set wb2 = Workbooks.Open(Filename:="C:\Users\Desktop\Workbook2.xlsx")
Set wb3 = Workbooks.Open(Filename:="C:\Users\Desktop\Workbook3.xlsx")
With wb2.Sheets(2)
Set wb2Paste = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
'Copy Data from Wb1.Sheet1 to Wb2.sheet1
wb1.Sheets(1).Range("A8:I38").Copy
wb2Paste.PasteSpecial Paste:=xlPasteValues, Transpose:=False
Application.CutCopyMode = False
Set wb2Paste = Nothing
wb2.Close SaveChanges:=True
With wb3.Sheets(1)
Set wb3Paste = .Range("A985")
End With
'Copy Data from Wb1.Sheet2 to Wb3.sheet1
wb1.Sheets(2).Range("A8:L497").Copy
wb3Paste.PasteSpecial Paste:=xlPasteAll, Transpose:=False
Application.CutCopyMode = False
Set wb3Paste = Nothing
wb3.Close SaveChanges:=True
Set wb2 = Nothing
Set wb3 = Nothing
wb1.Sheets(1).Range("A8:I38").ClearContents
wb1.Save
MsgBox "The destination worksheets were successfully updated!"
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "An error has occurred. If the problem persists use the email button on the home page to report the issue!", vbOKOnly + vbCritical, "Error Message"


End Sub

Display More

Check to see if 2 workbooks open and if yes exit sub

Participate now!

Share