Select sheets based on name

[theta]

Hi,

I need a VBA module or code that will find all sheets in the current workbook that contain the word "Section"

Then pass them into an array and select them

Sheets(Array("First Sheet", "Second Sheet")).Select

From here I will perform some actions but this is one part I am struggling with!

[theta]

Thiking of writing it like this, but need help forming the array



Public Function SelectSheets(sht as String, Optional wbk as Workbook)

Dim ws as Worksheet

For each ws in wbk.sheets

If InStr(1,ws.name,sht)



Then from here I need a logic test, if >0 then add the ws.name to an array...or redim an existing array. So eventually will have an array full of sheet name that meet the sht criteria...then this can be passed to the Sheets(Array()).Select statement?

[mancubus]

hi.
try this.


Sub ArrShtNames()

Dim wks As Worksheet
Dim ArrWks() As String
Dim cnt As Long
Dim i As Long

For Each wks In Worksheets
If InStr(1, wks.Name, "Section") > 0 Then
cnt = cnt + 1
End If
Next wks

ReDim ArrWks(0 To cnt - 1)
On Error Resume Next

For Each wks In Worksheets
If InStr(1, wks.Name, "Section") > 0 Then
ArrWks(i) = wks.Name
i = i + 1
End If
Next wks

'YOUR CODE

'example1: worksheet names in msgbox
For i = 0 To cnt - 1
MsgBox ArrWks(i)
Next i

'example2: worksheet names in activesheet cells
Range(Cells(1, 1), Cells(1, cnt)) = ArrWks

End Sub

[mdmackillop]

A minor change to avoid the first loop

Sub ArrShtNames()

Dim wks As Worksheet
Dim ArrWks() As String
Dim i As Long

ReDim ArrWks(0 To Worksheets.Count - 1)
For Each wks In Worksheets
If InStr(1, wks.Name, "Section") > 0 Then
ArrWks(i) = wks.Name
i = i + 1
End If
Next wks
ReDim Preserve ArrWks(i - 1)
Sheets(ArrWks).Select
End Sub

[mancubus]

A minor change to avoid the first loop


thanks.

i was working on below code to improve previous.
any idea?


Sub ArrShtNames()

Dim wks As Worksheet
Dim ArrWks() As String
Dim cnt As Long

For Each wks In Worksheets
If InStr(1, wks.Name, "Section") > 0 Then
cnt = cnt + 1
ReDim Preserve ArrWks(1 To cnt)
ArrWks(cnt) = wks.Name
End If
Next wks

End Sub

[theta]

I will try all 3, is the above edit finished?

[theta]

Just quick mention

I will probably call this function like :



If Not ArrShtNames("Section", ThisWorkbook) Then
GoTo TheEnd
Else
Sheets(Array(ArrWks)).Select


So I will need to set it up as a Public Sub / Function so that I can call it from within any module, passing the term ("Section") when it is called, along with an optional wbk (so if wbk is blank, use ActiveWorkbook)

Should only be some small tweaks?

[theta]

This appears to do the trick



Sub SelectSheets()
ArrShtNames ("Section")
End Sub

----------------------------------------------------------------

Public Sub ArrShtNames(sSheet As String)

Dim wks As Worksheet
Dim ArrWks() As String
Dim i As Long

ReDim ArrWks(0 To Worksheets.Count - 1)
For Each wks In Worksheets
If InStr(1, wks.Name, sSheet) > 0 Then
ArrWks(i) = wks.Name
i = i + 1
End If
Next wks
ReDim Preserve ArrWks(i - 1)
Sheets(ArrWks).Select
End Sub


I have called it a Public Sub because it will be in another Option Explicit module

Is this correct...

[mancubus]

in case sheet names do not contain the word "Section", adding error handler will be fine.

[theta]

What is the quickest way to implement this. Everybody does error handling different way?

I could change it to a public function, then call it as :

If Not ArrShtnames("Section") Then Exit Sub
Else
Sheets(Array(ArrWks)).Select
End If

This would solve my error problems?

[theta]

Just to be clear, the code now looks like this (and works) but without error handling :



Sub Test()
SelectSheets "Section", ThisWorkbook
'Some other bits and pieces here
End Sub

-------------------

Sub SelectSheets(sht As String, Optional wbk As Workbook)

Dim wks As Worksheet
Dim ArrWks() As String
Dim i As Long

If wbk Is Nothing Then Set wbk = ActiveWorkbook

ReDim ArrWks(0 To Worksheets.Count - 1)
For Each wks In Worksheets
If InStr(1, wks.Name, sht) > 0 Then
ArrWks(i) = wks.Name
i = i + 1
End If
Next wks
ReDim Preserve ArrWks(i - 1)
Sheets(ArrWks).Select
End Sub


Also, the main workbook containing this macro will open a second workbook using OpenFile, and the macro will then run on the new active workbook.

Do I need to use public sub, or sub?

What is the best use/reasoning for this?

[mancubus]

try this...



Sub SelectSheets()
ArrShtNames222 ("Dection")
End Sub

Public Function ArrShtNames222(sSheet As String)

Dim wks As Worksheet
Dim ArrWks() As String
Dim i As Long

ReDim ArrWks(0 To Worksheets.Count - 1)
For Each wks In Worksheets
If InStr(1, wks.Name, sSheet) > 0 Then
ArrWks(i) = wks.Name
i = i + 1
End If
Next wks

If Len(Join(ArrWks(), "")) = 0 Then
MsgBox "No worksheets found!"
Exit Function
End If

ReDim Preserve ArrWks(i - 1)
Sheets(ArrWks).Select

End Function

[theta]

I see the idea.

Had a play...want to handle errors outside of the sub (so that it can be called from multiple parts in the same module without interrupting the user).

This allows me to call the SelectSheets sub, and analyse the result...instead of having it dictate the result to me...thoughts?



Sub Test()
If Not SelectSheets("Section", ThisWorkbook) Then MsgBox ("There are no 'Section' sheets to print")
'Some other bits and pieces here
End Sub

----------------------------------------

Function SelectSheets(sht As String, Optional wbk As Workbook)

Dim wks As Worksheet
Dim ArrWks() As String
Dim i As Long

If wbk Is Nothing Then Set wbk = ActiveWorkbook

ReDim ArrWks(0 To Worksheets.Count - 1)
For Each wks In Worksheets
If InStr(1, wks.Name, sht) > 0 Then
ArrWks(i) = wks.Name
i = i + 1
End If
Next wks

If Len(Join(ArrWks(), "")) <> 0 Then
SelectSheets = True
ReDim Preserve ArrWks(i - 1)
Sheets(ArrWks).Select
Else
SelectSheets = False
End If

End Function


You guys have been a massive help

[mancubus]

it would be better to hear an expert's opinions.

looks fine to me.


Sub Test()

If Not SelectSheets("Section") Then MsgBox ("There are no 'Section' sheets to print")
'Some other bits and pieces here

End Sub

Function SelectSheets(sht As String, Optional wbk As Workbook) As Boolean

'SAME

End Function

[mdmackillop]

You can simplify the later code
If i > 0 Then
SelectSheets = True
ReDim Preserve ArrWks(i - 1)
Sheets(ArrWks).Select
Else
SelectSheets = False
End If