Sep 15 2020 06:33 AM
I have a userform that accesses data from an external workbook (at different times). I currently am opening this workbook and subsequent worksheets in each sub. In an effort to clean up duplicate coding, is there a way that I can create a sub that will open the workbook and in each required sub routine, access that workbook to extract data from it (Note: no writing is done to this workbook, only data extraction).
Sep 16 2020 06:28 AM
Solution@asmenut ,
If I understand your need, I would create a function to get the workbook for each routine. The function would only open the workbook if it isn't already open. So if a subroutine needs the workbook it would call GetWkb(). GetWkb() would see if the workbook is open, and if so, return it (quick!). If it isn't open, it would open it and return it.
Here is an example of one of the calling routines
Sub Sub1()
Dim oWkb As Workbook
Set oWkb = GetWkb
'Do something with the workbook here
End Sub
The function would be:
Public Function GetWkb() As Workbook
Static oWkb As Workbook 'Static to keep it in memory when this function ends
Const sWkb As String = "MyData.xlsx" 'Change this to your master workbook's name
Const sPath As String = "C:\Temp\" 'Change this to your master workbook's path
On Error GoTo ErrHandler
If Not oWkb Is Nothing Then
' Make sure it hasn't been closed by some other process
If oWkb.Name = vbNullString Then Set oWkb = Nothing
End If
If oWkb Is Nothing Then
' See if it was opened by some other process
Set oWkb = Application.Workbooks(sWkb)
' If still nothing, open the workbook
If oWkb Is Nothing Then
Set oWkb = Application.Workbooks.Open(Filename:=sPath & sWkb, ReadOnly:=True)
ActiveWindow.Visible = False
End If
End If
Set GetWkb = oWkb
ErrHandler:
Select Case Err.Number
Case Is = 0: 'No Error, Do nothing
Case Is = 9: Resume Next 'Workbook not open error
Case Is = -2147221080: Resume Next 'Workbook closed error
Case Else:
' Some unanticipated error happened so report it
MsgBox _
Prompt:="Error#" & Err.Number & vbLf & Err.Description, _
Buttons:=vbCritical + vbMsgBoxHelpButton, _
Title:="GetWkb", _
HelpFile:=Err.HelpFile, _
Context:=Err.HelpContext
End Select
End Function
Hope that helps
Sep 16 2020 10:11 AM
@Craig Hatmaker , works wonderfully. Thank you very much. The only addition I have to make to the specific sub routines is remembering to close the workbook and set to nothing (or else the grand automation error).
Sep 16 2020 12:56 PM
@asmenut ,
I recommend putting a routine in the Workbook_BeforeClose event to close the master workbook. I recommend the individual routines not attempt to close the master workbook. That would only slow things down.
Sep 16 2020 06:28 AM
Solution@asmenut ,
If I understand your need, I would create a function to get the workbook for each routine. The function would only open the workbook if it isn't already open. So if a subroutine needs the workbook it would call GetWkb(). GetWkb() would see if the workbook is open, and if so, return it (quick!). If it isn't open, it would open it and return it.
Here is an example of one of the calling routines
Sub Sub1()
Dim oWkb As Workbook
Set oWkb = GetWkb
'Do something with the workbook here
End Sub
The function would be:
Public Function GetWkb() As Workbook
Static oWkb As Workbook 'Static to keep it in memory when this function ends
Const sWkb As String = "MyData.xlsx" 'Change this to your master workbook's name
Const sPath As String = "C:\Temp\" 'Change this to your master workbook's path
On Error GoTo ErrHandler
If Not oWkb Is Nothing Then
' Make sure it hasn't been closed by some other process
If oWkb.Name = vbNullString Then Set oWkb = Nothing
End If
If oWkb Is Nothing Then
' See if it was opened by some other process
Set oWkb = Application.Workbooks(sWkb)
' If still nothing, open the workbook
If oWkb Is Nothing Then
Set oWkb = Application.Workbooks.Open(Filename:=sPath & sWkb, ReadOnly:=True)
ActiveWindow.Visible = False
End If
End If
Set GetWkb = oWkb
ErrHandler:
Select Case Err.Number
Case Is = 0: 'No Error, Do nothing
Case Is = 9: Resume Next 'Workbook not open error
Case Is = -2147221080: Resume Next 'Workbook closed error
Case Else:
' Some unanticipated error happened so report it
MsgBox _
Prompt:="Error#" & Err.Number & vbLf & Err.Description, _
Buttons:=vbCritical + vbMsgBoxHelpButton, _
Title:="GetWkb", _
HelpFile:=Err.HelpFile, _
Context:=Err.HelpContext
End Select
End Function
Hope that helps