Hiding sheets based on a list

Question

I want to hide sheets whose names are not present in a list.

I'm looking to replace the use of "Visible" with a reference to a list of cells in a worksheet named Visible.

I need to replace the "Visible" to a list of cells in Worksheet named Visible. The code should hide any sheets whose names are not found in this list.

Sub ocultarPlanilhas()
    Dim ws As Worksheet
    Sheets().Select
 
    For Each ws In Worksheets
        If ws.Name <> "Visible" Then
            ws.Visible = xlSheetHidden
        End If
    Next ws
End Sub

Answer 1

• sList will be a string in the format /Sheet12/Sheet2/Sheet3/
• InStr is used to compare ws.name with sList, and the MARKER is needed to prevent mismatching.

e.g. ws.Name = "Sheet1"

• InStr(1, sList, ws.Name, vbTextCompare) return 1 - it matchs a part of Sheet12
• InStr(1, sList, MARKER & ws.Name & MARKER, vbTextCompare) return 0 - /Sheet1/ is not in sList

Option Explicit

Sub HiddenSheet()
    Dim ws As Worksheet
    Dim rngList As Range, sList As String
    Const MARKER = "/"
    Const SheetName = "Sheet1" ' Modify as needed
    With Sheets(SheetName)
        Set rngList = .Range("Visible")
        ' Optional: Show at least one sheet before hidden sheets
        'Sheets(rngList.Cells(1).Value).Visible = xlSheetVisible
        sList = MARKER & Join(Application.Transpose(.Value), MARKER) & MARKER
    End With
    For Each ws In Worksheets
        If InStr(1, sList, MARKER & ws.Name & MARKER, vbTextCompare) = 0 Then
            ws.Visible = xlSheetHidden
        End If
    Next ws
End Sub

Answer 2

Hide/Show Sheets Not on a List

Sub HideShowSheets()
    Const PROC_TITLE As String = "Hide/Show Sheets"
    On Error GoTo ClearError
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Return the values from the single-column list
    ' in a 2D one-based single-column array ('Data').
    
    Dim ws As Worksheet: Set ws = wb.Sheets("Visible")
    
    Dim Data() As Variant, rCount As Long
    
    With ws.Range("A2")
        rCount = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row - .Row + 1
        Select Case rCount
            Case Is < 1:
                MsgBox "The list is empty!", vbExclamation, PROC_TITLE
                Exit Sub
            Case 1: ReDim Data(1 To 1, 1 To 1): Data(1, 1) = .Value
            Case Else: Data = .Resize(rCount).Value
        End Select
    End With
            
    ' Return the unique values from the array in the keys
    ' of a dictionary ('dict'), excluding errors and blanks.
            
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim r As Long, rValue As Variant
    
    For r = 1 To rCount
        rValue = Data(r, 1)
        If Not IsError(rValue) Then
            If Len(rValue) > 0 Then dict(rValue) = Empty
        End If
    Next r
    
    If dict.Count = 0 Then
        MsgBox "The list has no names!", vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    ' Loop through the sheets in the workbook and toggle the visibility
    ' of the sheets whose names are not on the list,
    ' applying the following logic:
    '  - if the sheet is visible, hide it.
    '  - if the sheet is not visible, unhide it.
    
    Dim sh As Object ' sheets = worksheets + charts
    
    For Each sh In wb.Sheets
        If Not dict.Exists(sh.Name) Then ' not in the list
            If sh.Visible = xlSheetVisible Then ' is visible
                sh.Visible = xlSheetHidden ' xlSheetVeryHidden
            Else ' is not visible
                ' If you remove the following line,
                ' the sheets will never become visible.
                sh.Visible = xlSheetVisible
            End If
        'Else ' is on the list; do nothing
        End If
    Next sh
    
    ' Inform.
    
    MsgBox "The sheets' visibility was toggled.", vbInformation, PROC_TITLE
    
ProcExit:
    Exit Sub
ClearError:
    MsgBox "Run-time error '" & Err.Number & "':" & vbLf & vbLf _
        & Err.Description, vbCritical, PROC_TITLE
    Resume ProcExit
End Sub