Below is part of the code I found that will list down all the sheets I have in the workbook as an option for the user to select and will assign the selected worksheet to ws2. Is it possible for me to hide/not show some of the sheets as an option for the user? Example: I have Sheet1 to Sheet10, when the dialog box display it will only show Sheet1, 2, 5, 7, 9, 10.
<code> Const ColItems As Long = 20
Const LetterWidth As Long = 20
Const HeightRowz As Long = 30
Const SheetID As String = "__SheetSelection"
Dim Y%, TopPos%, iSet%, optCols%, intLetters%, optMaxChars%, optLeft%
Dim wsDlg As DialogSheet, objOpt As OptionButton, optCaption$, objSheet As Object
optCaption = "": Y = 0
Application.ScreenUpdating = False
On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(SheetID).Delete
Application.DisplayAlerts = True
Err.Clear
Set wsDlg = ActiveWorkbook.DialogSheets.Add
With wsDlg
.Name = SheetID
.Visible = xlSheetHidden
iSet = 0: optCols = 0: optMaxChars = 0: optLeft = 100: TopPos = 40
For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Visible = xlSheetVisible Then
Y = Y + 1
If Y Mod ColItems = 1 Then
optCols = optCols + 1
TopPos = 45
optLeft = optLeft + (optMaxChars * LetterWidth)
optMaxChars = 0
End If
intLetters = Len(objSheet.Name)
If intLetters > optMaxChars Then optMaxChars = intLetters
iSet = iSet + 1
.OptionButtons.Add optLeft, TopPos, intLetters * LetterWidth, 16
.OptionButtons(iSet).Text = objSheet.Name
TopPos = TopPos + 15
End If
Next objSheet
If Y > 0 Then
'.Buttons.Left = optLeft + (optMaxChars * LetterWidth) + 24
With .DialogFrame
.Height = Application.Max(80, WorksheetFunction.Min(iSet, ColItems) * HeightRowz + 10)
.Width = optLeft + (optMaxChars * LetterWidth)
.Caption = "Select sheet"
End With
.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront
'Application.ScreenUpdating = False
If .Show = True Then
For Each objOpt In wsDlg.OptionButtons
If objOpt.Value = xlOn Then
optCaption = objOpt.Caption
ElseIf objOpt.Value = "General" Then
optCaption = ""
Exit For
End If
Next objOpt
End If
If optCaption = "" Then
'Or optCaption = "Sheet2"
MsgBox "You did not select a worksheet.", 48, "Cannot continue"
If .Show = True Then
For Each objOpt In wsDlg.OptionButtons
If objOpt.Value = xlOn Then
optCaption = objOpt.Caption
ElseIf objOpt.Value = "General" Then
optCaption = ""
Exit For
End If
Next objOpt
End If
ElseIf optCaption = "Sheet1" Or optCaption = "Sheet2" Or optCaption = "Sheet6" Or optCaption = "Sheet7" Then
MsgBox "Invalid", 48, "Cannot Continue"
Exit Sub
Else
Set ws2 = Worksheets(optCaption)
End If
End If
End With
</code>
<code> Const ColItems As Long = 20
Const LetterWidth As Long = 20
Const HeightRowz As Long = 30
Const SheetID As String = "__SheetSelection"
Dim Y%, TopPos%, iSet%, optCols%, intLetters%, optMaxChars%, optLeft%
Dim wsDlg As DialogSheet, objOpt As OptionButton, optCaption$, objSheet As Object
optCaption = "": Y = 0
Application.ScreenUpdating = False
On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(SheetID).Delete
Application.DisplayAlerts = True
Err.Clear
Set wsDlg = ActiveWorkbook.DialogSheets.Add
With wsDlg
.Name = SheetID
.Visible = xlSheetHidden
iSet = 0: optCols = 0: optMaxChars = 0: optLeft = 100: TopPos = 40
For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Visible = xlSheetVisible Then
Y = Y + 1
If Y Mod ColItems = 1 Then
optCols = optCols + 1
TopPos = 45
optLeft = optLeft + (optMaxChars * LetterWidth)
optMaxChars = 0
End If
intLetters = Len(objSheet.Name)
If intLetters > optMaxChars Then optMaxChars = intLetters
iSet = iSet + 1
.OptionButtons.Add optLeft, TopPos, intLetters * LetterWidth, 16
.OptionButtons(iSet).Text = objSheet.Name
TopPos = TopPos + 15
End If
Next objSheet
If Y > 0 Then
'.Buttons.Left = optLeft + (optMaxChars * LetterWidth) + 24
With .DialogFrame
.Height = Application.Max(80, WorksheetFunction.Min(iSet, ColItems) * HeightRowz + 10)
.Width = optLeft + (optMaxChars * LetterWidth)
.Caption = "Select sheet"
End With
.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront
'Application.ScreenUpdating = False
If .Show = True Then
For Each objOpt In wsDlg.OptionButtons
If objOpt.Value = xlOn Then
optCaption = objOpt.Caption
ElseIf objOpt.Value = "General" Then
optCaption = ""
Exit For
End If
Next objOpt
End If
If optCaption = "" Then
'Or optCaption = "Sheet2"
MsgBox "You did not select a worksheet.", 48, "Cannot continue"
If .Show = True Then
For Each objOpt In wsDlg.OptionButtons
If objOpt.Value = xlOn Then
optCaption = objOpt.Caption
ElseIf objOpt.Value = "General" Then
optCaption = ""
Exit For
End If
Next objOpt
End If
ElseIf optCaption = "Sheet1" Or optCaption = "Sheet2" Or optCaption = "Sheet6" Or optCaption = "Sheet7" Then
MsgBox "Invalid", 48, "Cannot Continue"
Exit Sub
Else
Set ws2 = Worksheets(optCaption)
End If
End If
End With
</code>
Const ColItems As Long = 20
Const LetterWidth As Long = 20
Const HeightRowz As Long = 30
Const SheetID As String = "__SheetSelection"
Dim Y%, TopPos%, iSet%, optCols%, intLetters%, optMaxChars%, optLeft%
Dim wsDlg As DialogSheet, objOpt As OptionButton, optCaption$, objSheet As Object
optCaption = "": Y = 0
Application.ScreenUpdating = False
On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(SheetID).Delete
Application.DisplayAlerts = True
Err.Clear
Set wsDlg = ActiveWorkbook.DialogSheets.Add
With wsDlg
.Name = SheetID
.Visible = xlSheetHidden
iSet = 0: optCols = 0: optMaxChars = 0: optLeft = 100: TopPos = 40
For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Visible = xlSheetVisible Then
Y = Y + 1
If Y Mod ColItems = 1 Then
optCols = optCols + 1
TopPos = 45
optLeft = optLeft + (optMaxChars * LetterWidth)
optMaxChars = 0
End If
intLetters = Len(objSheet.Name)
If intLetters > optMaxChars Then optMaxChars = intLetters
iSet = iSet + 1
.OptionButtons.Add optLeft, TopPos, intLetters * LetterWidth, 16
.OptionButtons(iSet).Text = objSheet.Name
TopPos = TopPos + 15
End If
Next objSheet
If Y > 0 Then
'.Buttons.Left = optLeft + (optMaxChars * LetterWidth) + 24
With .DialogFrame
.Height = Application.Max(80, WorksheetFunction.Min(iSet, ColItems) * HeightRowz + 10)
.Width = optLeft + (optMaxChars * LetterWidth)
.Caption = "Select sheet"
End With
.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront
'Application.ScreenUpdating = False
If .Show = True Then
For Each objOpt In wsDlg.OptionButtons
If objOpt.Value = xlOn Then
optCaption = objOpt.Caption
ElseIf objOpt.Value = "General" Then
optCaption = ""
Exit For
End If
Next objOpt
End If
If optCaption = "" Then
'Or optCaption = "Sheet2"
MsgBox "You did not select a worksheet.", 48, "Cannot continue"
If .Show = True Then
For Each objOpt In wsDlg.OptionButtons
If objOpt.Value = xlOn Then
optCaption = objOpt.Caption
ElseIf objOpt.Value = "General" Then
optCaption = ""
Exit For
End If
Next objOpt
End If
ElseIf optCaption = "Sheet1" Or optCaption = "Sheet2" Or optCaption = "Sheet6" Or optCaption = "Sheet7" Then
MsgBox "Invalid", 48, "Cannot Continue"
Exit Sub
Else
Set ws2 = Worksheets(optCaption)
End If
End If
End With
Making changes to this part of the code works but not sure if it is effective.
<code> For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Visible = xlSheetVisible Then
Y = Y + 1
If objSheet.Name <> "Sheet1" And objSheet.Name <> "Sheet2" And objSheet.Name <> "Sheet6" And objSheet.Name <> "Sheet7" Then
If Y Mod ColItems = 1 Then
optCols = optCols + 1
TopPos = 45
optLeft = optLeft + (optMaxChars * LetterWidth)
optMaxChars = 0
End If
intLetters = Len(objSheet.Name)
If intLetters > optMaxChars Then optMaxChars = intLetters
iSet = iSet + 1
.OptionButtons.Add optLeft, TopPos, intLetters * LetterWidth, 16
.OptionButtons(iSet).Text = objSheet.Name
TopPos = TopPos + 15
End If
End If
Next objSheet
</code>
<code> For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Visible = xlSheetVisible Then
Y = Y + 1
If objSheet.Name <> "Sheet1" And objSheet.Name <> "Sheet2" And objSheet.Name <> "Sheet6" And objSheet.Name <> "Sheet7" Then
If Y Mod ColItems = 1 Then
optCols = optCols + 1
TopPos = 45
optLeft = optLeft + (optMaxChars * LetterWidth)
optMaxChars = 0
End If
intLetters = Len(objSheet.Name)
If intLetters > optMaxChars Then optMaxChars = intLetters
iSet = iSet + 1
.OptionButtons.Add optLeft, TopPos, intLetters * LetterWidth, 16
.OptionButtons(iSet).Text = objSheet.Name
TopPos = TopPos + 15
End If
End If
Next objSheet
</code>
For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Visible = xlSheetVisible Then
Y = Y + 1
If objSheet.Name <> "Sheet1" And objSheet.Name <> "Sheet2" And objSheet.Name <> "Sheet6" And objSheet.Name <> "Sheet7" Then
If Y Mod ColItems = 1 Then
optCols = optCols + 1
TopPos = 45
optLeft = optLeft + (optMaxChars * LetterWidth)
optMaxChars = 0
End If
intLetters = Len(objSheet.Name)
If intLetters > optMaxChars Then optMaxChars = intLetters
iSet = iSet + 1
.OptionButtons.Add optLeft, TopPos, intLetters * LetterWidth, 16
.OptionButtons(iSet).Text = objSheet.Name
TopPos = TopPos + 15
End If
End If
Next objSheet
2
Firstly, please repair the code as it is taking in consideration my above comment suggestions. Besides End With it also needs an End If code line.
Now, in order to iterate between a limited group of sheets there are more possibilities. To make a simple example I will firstly try using your construction, respectively:
<code>Sub originalIterationWay()
Dim objSheet As Object
For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Name <> "Sheet1" And objSheet.Name <> "Sheet4" Then 'except these sheets
Debug.Print objSheet.Name
End If
Next objSheet
End Sub
</code>
<code>Sub originalIterationWay()
Dim objSheet As Object
For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Name <> "Sheet1" And objSheet.Name <> "Sheet4" Then 'except these sheets
Debug.Print objSheet.Name
End If
Next objSheet
End Sub
</code>
Sub originalIterationWay()
Dim objSheet As Object
For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Name <> "Sheet1" And objSheet.Name <> "Sheet4" Then 'except these sheets
Debug.Print objSheet.Name
End If
Next objSheet
End Sub
Such a way is feasible if there are not many sheets and you need to exclude a limited number of them.
When there are a lot of sheets on the workbook and you need to iterate between a limited number of them you can try the next ways:
- Place the respective sheets names in an array and iterate only between these one:
<code>Sub playWithSheetNamesArray()
Dim arrSh: arrSh = Array("Sheet1", "Sheet2", "Sheet5", "Sheet7")
Dim objSheet As Object
For Each objSheet In Worksheets(arrSh)
Debug.Print objSheet.Name
Next objSheet
End Sub
</code>
<code>Sub playWithSheetNamesArray()
Dim arrSh: arrSh = Array("Sheet1", "Sheet2", "Sheet5", "Sheet7")
Dim objSheet As Object
For Each objSheet In Worksheets(arrSh)
Debug.Print objSheet.Name
Next objSheet
End Sub
</code>
Sub playWithSheetNamesArray()
Dim arrSh: arrSh = Array("Sheet1", "Sheet2", "Sheet5", "Sheet7")
Dim objSheet As Object
For Each objSheet In Worksheets(arrSh)
Debug.Print objSheet.Name
Next objSheet
End Sub
You need to load in the array the real name of the sheets you need to iterate between.
- You can place in an array the sheets needed to be iterated index:
<code>Sub playWithSheetsIndexesArray()
Dim arrSh: arrSh = Array(1, 2, 5, 7, 9, 10)
Dim objSheet As Object
Dim i As Long
For i = 0 To UBound(arrSh)
Set objSheet = Worksheets(arrSh(i))
Debug.Print objSheet.Name
Next i
End Sub
</code>
<code>Sub playWithSheetsIndexesArray()
Dim arrSh: arrSh = Array(1, 2, 5, 7, 9, 10)
Dim objSheet As Object
Dim i As Long
For i = 0 To UBound(arrSh)
Set objSheet = Worksheets(arrSh(i))
Debug.Print objSheet.Name
Next i
End Sub
</code>
Sub playWithSheetsIndexesArray()
Dim arrSh: arrSh = Array(1, 2, 5, 7, 9, 10)
Dim objSheet As Object
Dim i As Long
For i = 0 To UBound(arrSh)
Set objSheet = Worksheets(arrSh(i))
Debug.Print objSheet.Name
Next i
End Sub
In this case you can use the sheets indexes (their position, starting with one), independent of their name. I mean, if you will name “Sheet1” as “My First Sheet”, it will return/use “My First Sheet” sheet.
Please, send some feedback after testing it. If something not clar enough, do not hesitate to ask for clarifications…
4