XLA routines: EE_HideSheets

Nick's picture
EE_HideSheets is a sub routine that hides any sheets that are not in the range of sheet names specified, or hides everything in the range if blnReverseSelection is true
Sub EE_HideSheets(ArrayOrRange, Optional blnReverseSelection As Boolean = False)
'> - takes an array or range
'> - Hide any sheets that are/not contained in the array\range
    Dim arr
    Dim intWksCount         As Integer
    Dim blnDelete           As Boolean
    Dim blnDelete2          As Boolean
    Dim wbk                 As Workbook
    Dim intShtAdded         As Integer
    Dim intShtAdded2        As Integer
'http://excelexperts.com/xla-routines-eeHideSheets   for updates on this sub routine
    Set wbk = ThisWorkbook
    Select Case TypeName(ArrayOrRange)
        Case "Variant()"
            arr = ArrayOrRange
        Case "Range"
            arr = Application.Transpose(ArrayOrRange)
        Case "String"
            arr = Array(ArrayOrRange)
        Case Else
            Exit Sub
    End Select
    For intWksCount = 1 To wbk.Worksheets.Count
        On Error Resume Next
        Call Application.WorksheetFunction.Match(wbk.Worksheets(intWksCount).Name, arr, 0)
        If Err.Number <> 0 Then 'Found in Range/Array
            If intShtAdded = 0 Then
                ReDim arrTemp(0)
                ReDim Preserve arrTemp(UBound(arrTemp) + 1)
            End If
            intShtAdded = intShtAdded + 1
            arrTemp(UBound(arrTemp)) = wbk.Worksheets(intWksCount).Name
            blnDelete = True
            If intShtAdded2 = 0 Then
                ReDim arrtemp2(0)
                ReDim Preserve arrtemp2(UBound(arrtemp2) + 1)
            End If
            intShtAdded2 = intShtAdded2 + 1
            arrtemp2(UBound(arrtemp2)) = wbk.Worksheets(intWksCount).Name
            blnDelete2 = True
        End If
        Err.Clear: On Error GoTo 0: On Error GoTo -1
    Next intWksCount
    If blnReverseSelection = False And blnDelete = True Then
        wbk.Worksheets(arrtemp2).Visible = xlSheetHidden
    ElseIf blnReverseSelection = True And blnDelete2 = True Then
        wbk.Worksheets(arrTemp).Visible = xlSheetHidden
    End If
    On Error Resume Next
        Erase arr
        Erase arrTemp
        Erase arrtemp2
    Err.Clear: On Error GoTo 0: On Error GoTo -1
    Set wbk = Nothing
End Sub