VBA - select specific sheets within workbook to loop through - vba

Question

I have an excel workbook with a variable number of sheets. At the moment I am looping through all sheets and therein a specific column to search for figures above a certain threshold. Column and threshold are determined by inputboxes that need to be filled in by the user. If the figure in the column, let's say column "J" and row 10 is above threshold, row 10 is copied and pasted in a new created "summary" sheet etc.
I am struggling at the moment with a specific selection of sheets. I don't always want to loop through all sheets but instead would like to have another inputbox or something else in which I can select specific sheets (STRG + "sheetx" "sheety" etc...) that are looped through?! Anyone an idea how I can accomplish that with my code? I know that I have to change my "for each" statement to substitute for the selected sheets but I don't know how to create the inputbox to select specific tabs...
Any help appreciated!
Option Explicit
Sub Test()
Dim column As String
Dim WS As Worksheet
Dim i As Long, j As Long, lastRow As Long
Dim sh As Worksheet
Dim sheetsList As Variant
Dim threshold As Long
Set WS = GetSheet("Summary", True)
threshold = Application.InputBox("Input threshold", Type:=1)
column = Application.InputBox("Currency Column", Type:=2)
j = 2
For Each sh In ActiveWorkbook.Sheets
If sh.Name <> "Summary" Then
lastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
For i = 4 To lastRow
If sh.Range(column & i) > threshold Or sh.Range(column & i) < -threshold Then
sh.Range("a" & i & ":n" & i).Copy Destination:=WS.Range("A" & j)
WS.Range("N" & j) = sh.Name
j = j + 1
End If
Next i
End If
Next sh
WS.Columns("A:N").AutoFit
End Sub
Function GetSheet(shtName As String, Optional clearIt As Boolean = False) As Worksheet
On Error Resume Next
Set GetSheet = Worksheets(shtName)
If GetSheet Is Nothing Then
Set GetSheet = Sheets.Add(after:=Worksheets(Worksheets.Count))
GetSheet.Name = shtName
End If
If clearIt Then GetSheet.UsedRange.Clear
End Function

Answer 1

in the "NO-UserForm" mood you could use a combination of Dictionary object and the Application.InputBox() method when setting its Type parameter to 8 and have it accept range selections:
Function GetSheets() As Variant
Dim rng As Range
On Error Resume Next
With CreateObject("Scripting.Dictionary")
Do
Set rng = Nothing
Set rng = Application.InputBox(prompt:="Select any range in wanted Sheet", title:="Sheets selection", Type:=8)
.item(rng.Parent.Name) = rng.Address
Loop While Not rng Is Nothing
GetSheets = .keys
End With
End Function
this function gets the Parent sheet name out of each range selected by the user switching through sheets and stops when the user clicks the Cancel button or closes the InputBox
to be exploited by your "main" sub as follows:
Sub main()
Dim ws As Worksheet
For Each ws In Sheets(GetSheets) '<--| here you call GetSheets() Function and have user select sheets to loop through
MsgBox ws.Name
Next
End Sub

Answer 2

Agreed that a UserForm could offer a more appealing way to define it, however the InputBox approach isn't bad. The following code creates an InputBox that accepts a sheet range entry in the same way as a print dialog accepts page numbers, i.e. either explicit sheet numbers separated by commas (1, 3, 9) or a range separated with a hyphen (1-9).
This will look like a lot of code but it's got some error handling to prevent ugly failures. Your loop For Each sh In ActiveWorkbook.Sheets would be replaced by a loop like the example at the bottom of the code.
Sub sheetLoopInputBox()
Dim mySheetsArr2(999)
'Gather sheet range from inputbox:
mySheets = Replace(InputBox("Enter sheet numbers you wish to work on, e.g.:" & vbNewLine & vbNewLine & _
"1-3" & vbNewLine & _
"1,3,5,7,15", "Sheets", ""), " ", "")
If mySheets = "" Then Exit Sub 'user clicked cancel or entered a blank
'Remove spaces from string:
If InStr(mySheets, " ") Then mySheets = Replace(mySheets, " ", "")
If InStr(mySheets, ",") Then
'Comma separated values...
'Create array:
mySheetsArr1 = Split(mySheets, ",")
'Test if user entered numbers by trying to do maths, and create final array:
On Error Resume Next
For i = 0 To UBound(mySheetsArr1)
mySheetsArr2(i) = mySheetsArr1(i) * 1
If Err.Number <> 0 Then
Err.Clear
MsgBox "Error, did not understand sheets entry."
Exit Sub
End If
Next i
i = i - 1
ElseIf InStr(mySheets, "-") Then
'Hyphen separated range values...
'Check there's just one hyphen
If Len(mySheets) <> (Len(Replace(mySheets, "-", "")) + 1) Then
MsgBox "Error, did not understand sheets entry."
Exit Sub
End If
'Test if user entered numbers by trying to do maths:
On Error Resume Next
temp = Split(mySheets, "-")(0) * 1
temp = Split(mySheets, "-")(1) * 1
If Err.Number <> 0 Then
Err.Clear
MsgBox "Error, did not understand sheets entry."
Exit Sub
End If
On Error GoTo 0
'Create final array:
i = 0
i = i - 1
For j = Split(mySheets, "-")(0) * 1 To Split(mySheets, "-")(1) * 1
i = i + 1
mySheetsArr2(i) = j
Next j
End If
'A loop to do your work:
'(work through the sheet numbers stored in the array mySheetsArr2):
For j = 0 To i
'example1:
MsgBox mySheetsArr2(j)
'example2:
'Sheets(mySheetsArr2(j)).Cells(1, 1).Value = Now()
'Sheets(mySheetsArr2(j)).Columns("A:A").AutoFit
Next j
End Sub