Exists()
This checks a collection or array for an item or element. If requested Exists() passes the item or element back to us in vItem.
NOTE! vItem is declared ByRef making its value accessible to the calling routine.
Example:
I use this constantly to make sure things needed by a routine are there. In the example below I am checking a workbook to see if a worksheet I need exists. If found, the worksheet is placed in oWks. If not, an error is raised:
' Check Inputs and requisites
If Not Exists(oWkb.Worksheets, "ACTs", oWks) Then Err.Raise DspError, , _
"Problem:" & vbTab & "Worksheet ACTs not found" & vbLf & _
"Fix:" & vbTab & "Click 'Import Tables' icon to add worksheet and configuration tables"
Code:
Below is the routine. This routine does not work with all possible Excel object collections but I have found this easy to modify as I come across collections I need to check as evidenced by the modification history.
Public Function Exists(ByVal vCollection As Variant, _
ByVal sName As String, _
Optional ByRef vItem As Variant) As Boolean
' Description:Determine if a name exists in a collection
' Inputs: vCollection Collection to check
' sName Collection Item's Name
' vItem Variable to hold collection instance
' Outputs: Me Success/Failure
' Requisites: *None
' Example: ?Exists(Worksheets, "UsrCodes")
' ?Exists(ActiveWorkbook.Names, "WBS", vItem)
' ?Exists(ThisWorkbook.Styles, "Bad", vItem)
' ?Exists(Workbooks(2).TableStyles, "TableStyleMedium14", vItem)
' ?Exists(ActiveSheet.Shapes, "Button", vItem)
' ?Exists(Array("Input", "Bad", "Good", "Neutral"), Selection.Style.Name)
' Date Ini Modification
' 06/25/01 CWH Initial Development
' 08/01/13 CWH Test for Blank Item
' 10/22/13 CWH Covered oCollection not set
' 12/04/15 CWH Now handles arrays
' 10/28/16 CWH Now handles Dictionaries
' 09/26/17 CWH Now handles SeriesCollection
' 02/08/18 CWH Make sure vItem doesn't return something on failure
' 12/08/18 CWH Add AddIns object collection type
' 02/26/19 CWH Add SlicerPivotTables
' Declarations
Const cRoutine As String = "Exists"
Dim v As Variant
' Error Handling Initialization
On Error GoTo ErrHandler
Exists = False
' Procedure
Select Case TypeName(vCollection)
Case Is = "String"
vItem = vbNullString
Exists = InStr(1, vCollection, sName) > 0
Case Is = "Range"
Set vItem = vCollection.Find(What:=sName, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If vItem Is Nothing Then Err.Raise 5
Exists = True
Case Is = "Variant()", "String()"
vItem = vbNullString
For Each v In vCollection
If CStr(v) = sName Then
vItem = v
Exists = True
Exit For
End If
Next
Case Is = "Dictionary"
Set vItem = Nothing
Exists = vCollection.Exists(sName)
If Exists Then
If IsObject(vCollection(sName)) Then _
Set vItem = vCollection(sName) Else _
vItem = vCollection(sName)
End If
Case Is = "SeriesCollection", "AddIns", "SlicerPivotTables"
Set vItem = Nothing
For Each v In vCollection
If v.Name = sName Then
Set vItem = v
Exists = True
Exit For
End If
Next
Case Else
If IsObject(vCollection) Then
Set vItem = Nothing
If IsObject(vCollection(sName)) Then
Set vItem = vCollection(sName)
Exists = True
Else
vItem = vbNullString
vItem = vCollection(sName)
Exists = True
End If
End If
End Select
ErrHandler:
Select Case Err.Number
Case Is = NoError: 'Do nothing
Case Is = 5, 9, 13, 91, 1004, 3265, -2147024809 'Do Nothing (not found)
Case Else:
Select Case DspErrMsg(cModule & "." & cRoutine)
Case Is = vbAbort: Stop: Resume 'Debug mode - Trace
Case Is = vbRetry: Resume 'Try again
Case Is = vbIgnore: 'End routine
End Select
End Select
End Function
Additional Resources:
DspErrMsg()