I am trying to loop through a subset of tabs in a workbook. I know I can explicitly name them, but tabs can be added or removed frequently enough that I think that may be a hassle to maintain. The tabs I need to adjust are in consecutive order. Is there a way to loop through a range of tabs?
For example if I have a workbook with 26 tabs A-Z can I loop through D-W with only the first and last tab name?
Maybe like this:
Dim x As Long, wb As Workbook
Set wb = ThisWorkbook
For x = wb.Worksheets("D").Index to wb.Worksheets("W").Index
With wb.Worksheets(x)
'do something with the sheet
End with
Next x
Option Explicit
Sub test()
Dim WS As Worksheet
For Each WS In ThisWorkbook.Worksheets
If StrComp(WS.Name, "C") = 1 And StrComp(WS.Name, "X") = -1 Then
WS.Activate
Range("A1").Value = "Done"
End If
Next
End Sub
The Examples
Sub ArrWorksheetNamesLettersTEST1()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim Arr As Variant: Arr = ArrWorksheetNamesLetters(wb, "D", "W")
If IsEmpty(Arr) Then Exit Sub ' no matching worksheet
Dim ws As Worksheet
For Each ws In wb.Worksheets(Arr)
Debug.Print ws.Name
Next ws
End Sub
Sub ArrWorksheetNamesLettersTEST2()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim Arr As Variant
' The order of the letters is not relevant.
' Only the first letters are considered.
' Case is not relevant when 'MatchCase = False' (default).
Arr = ArrWorksheetNamesLetters(wb, "S", "dsadf")
If Not IsEmpty(Arr) Then
Debug.Print Join(Arr, vbLf)
Else
Debug.Print "Nope."
End If
' Case is relevant when 'MatchCase = True': both need to have the same case.
Arr = ArrWorksheetNamesLetters(wb, "d", "s", True)
If Not IsEmpty(Arr) Then
Debug.Print Join(Arr, vbLf)
Else
Debug.Print "Nope."
End If
End Sub
The Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: From a workbook ('wb'), returns the names of the worksheets,
' whose names start with a letter from a given range of letters
' ('Letter1' ,'Letter2'), in a one-based array.
' Remarks: The order of the worksheets is not relevant.
' The order of the letters is not relevant.
' The case of the letters is relevant only
' when 'MatchCase = True': then both have to be of the same case.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ArrWorksheetNamesLetters( _
ByVal wb As Workbook, _
ByVal Letter1 As String, _
ByVal Letter2 As String, _
Optional ByVal MatchCase As Boolean = False) _
As Variant
Const uMin As Long = 65
Const uMax As Long = 90
Const lMin As Long = 97
Const lMax As Long = 122
Const Diff As Long = 32
Dim asc1 As Long: asc1 = Asc(Left(Letter1, 1))
Dim asc2 As Long: asc2 = Asc(Left(Letter2, 1))
Dim IsLCase As Boolean
If asc1 < uMin Then Exit Function
If asc1 > uMax Then
If asc1 < lMin Then Exit Function
If asc1 > lMax Then Exit Function
' lMin <= asc1 <= lMax
If MatchCase Then
IsLCase = True
Else
asc1 = asc1 - Diff
End If
'Else ' uMin <= asc1 <= uMax
End If
If asc2 < uMin Then Exit Function
If asc2 > uMax Then
If asc2 < lMin Then Exit Function
If asc2 > lMax Then Exit Function
' lMin <= asc2 <= lMax
If MatchCase Then
If Not IsLCase Then Exit Function
Else
asc2 = asc2 - Diff
End If
Else ' uMin <= asc2 <= uMax
If MatchCase Then
If IsLCase Then Exit Function
End If
End If
Dim cStart As Long, cEnd As Long
If asc1 <= asc2 Then
cStart = asc1: cEnd = asc2
Else
cStart = asc2: cEnd = asc1
End If
Dim wsCount As Long: wsCount = wb.Worksheets.Count
Dim Arr() As String: ReDim Arr(1 To wsCount)
Dim cCount As Long: cCount = 2
If MatchCase Then cCount = 1
Dim sws As Worksheet
Dim cCHR As Long
Dim n As Long
Dim c As Long
For Each sws In wb.Worksheets
For c = 1 To cCount
cCHR = Asc(Left(sws.Name, 1))
If cCHR >= (c - 1) * Diff + cStart Then
If cCHR <= (c - 1) * Diff + cEnd Then
n = n + 1
Arr(n) = sws.Name
Exit For
End If
End If
Next c
Next sws
If n = 0 Then Exit Function
If n < wsCount Then ReDim Preserve Arr(1 To n)
ArrWorksheetNamesLetters = Arr
End Function