Userform to select worksheet

[begoldar]

Hi Everyone,

I'm trying to make a new userform that will activate a worksheet based upon a user choice in a dropdown menu. Is there a way to do this? Thanks!

 

[cyborgt100]

this code is prefect for me but if i wanted to limited to the first 4 sheet of the work book how can limited the sheets the user can choose from ????

 

[Tom Urtis]

Assuming by "the first 4 sheet (sic) of the work book" you mean the first 4 index sheets, which may or may not be tab-named or code named Sheet1, Sheet2, Sheet3, and Sheet4, then simply edit this line of code...

If objSheet.Visible = xlSheetVisible Then

to this...

If objSheet.Visible = xlSheetVisible And Sheets(objSheet.Name).Index <= 4 Then

 

[keikokeiko10]

first you should set the list in the drop down list i suggest that the list in the drop down list is based on the sheet name

 

[keikokeiko10]

then...write this in a cmd button
if combobox1.value = "sheet name in the list" then
worksheets("sheet name").activate
end if

 

[billy1989]

If you are absolutely requiring a programmatic solution, there are several options available to you.

One is what I posted here
ComboBox for selection sheet and run macro
which places a combobox on the menu bar of your workbook for a drop-down list of all sheets in the workbook, and will only be active when that workbook is active.

Note, if other users are using 2007 then this combobox will not appear on the ribbon but it will be an add-in, so this option is best with versions <=XP.



Another alternative is the below macro which, if you stick it in a standard module, will let the user choose their desired sheet from option buttons which will list all visible sheets in the workbook. Presumably you would not want people activating hidden sheets, that's why you would have hidden them, so I wrote the code for visible sheets only.

Sub SheetSelector()
Const ColItems  As Long = 20
Const LetterWidth As Long = 20
Const HeightRowz As Long = 18
Const SheetID As String = "__SheetSelection"
 
Dim i%, TopPos%, iSet%, optCols%, intLetters%, optMaxChars%, optLeft%
Dim wsDlg As DialogSheet, objOpt As OptionButton, optCaption$, objSheet As Object
optCaption = "": i = 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 = 78: TopPos = 40
 
For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Visible = xlSheetVisible Then
i = i + 1
 
If i Mod ColItems = 1 Then
optCols = optCols + 1
TopPos = 40
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.5
.OptionButtons(iSet).text = objSheet.Name
TopPos = TopPos + 13
 
End If
Next objSheet
 
If i > 0 Then
 
.Buttons.Left = optLeft + (optMaxChars * LetterWidth) + 24
 
With .DialogFrame
.Height = Application.Max(68, WorksheetFunction.Min(iSet, ColItems) * HeightRowz + 10)
.Width = optLeft + (optMaxChars * LetterWidth) + 24
.Caption = "Select sheet to go to"
End With
 
.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront
Application.ScreenUpdating = True
 
If .Show = True Then
For Each objOpt In wsDlg.OptionButtons
If objOpt.Value = xlOn Then
optCaption = objOpt.Caption
Exit For
End If
Next objOpt
End If
 
If optCaption = "" Then
MsgBox "You did not select a worksheet.", 48, "Cannot continue"
Exit Sub
Else
 
MsgBox "You selected the sheet named ''" & optCaption & "''." & vbCrLf & "Click OK to go there.", 64, "FYI:"
Sheets(optCaption).Activate
 
End If
 
End If
 
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
 
End With
End Sub

This is fantastic! The only thing I can't work out is how to move the buttons to the bottom rather than the top right?

 

[Tom Urtis]

This is fantastic! The only thing I can't work out is how to move the buttons to the bottom rather than the top right?

If I were you I would keep it the way it is, because "to the bottom" means below however many sheets there are after some reasonable interval spacing. What you want can be achieved dynamically but the form will look too vertical in my opinion. I guarantee that although it might visually suit your personal preference, your users will say "Where's OK and Cancel", or they will need to scroll down to find those 2 buttons when those buttons should be in my opinion, and are as I posted the code, prominently obvious at the right of the dialog form.

 

[billy1989]

If I were you I would keep it the way it is, because "to the bottom" means below however many sheets there are after some reasonable interval spacing. What you want can be achieved dynamically but the form will look too vertical in my opinion. I guarantee that although it might visually suit your personal preference, your users will say "Where's OK and Cancel", or they will need to scroll down to find those 2 buttons when those buttons should be in my opinion, and are as I posted the code, prominently obvious at the right of the dialog form.

I'll be the only user, so that's not an issue!

 

[Tom Urtis]

Sub SheetSelector2()

Const ColItems  As Long = 20
Const LetterWidth As Long = 20
Const HeightRowz As Long = 18
Const SheetID As String = "__SheetSelection"
 
Dim i%, TopPos%, iSet%, optCols%, intLetters%, optMaxChars%, optLeft%
Dim wsDlg As DialogSheet, objOpt As OptionButton, optCaption$, objSheet As Object
optCaption = "": i = 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 = 78: TopPos = 40
 
For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Visible = xlSheetVisible Then
i = i + 1
 
If i Mod ColItems = 1 Then
optCols = optCols + 1
TopPos = 40
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.5
.OptionButtons(iSet).Text = objSheet.Name
TopPos = TopPos + 13
 
End If
Next objSheet
 
If i > 0 Then
 
.Buttons.Left = optLeft + (optMaxChars * LetterWidth) + 24
 
With .DialogFrame
.Height = Application.Max(68, WorksheetFunction.Min(iSet, ColItems) * HeightRowz + 10)
.Width = optLeft + 60
.Caption = "Select sheet to go to:"
End With
 
With .Buttons("Button 2")
.BringToFront
.Left = optLeft
.Top = HeightRowz + TopPos
End With

With .Buttons("Button 3")
.BringToFront
.Left = optLeft + 60
.Top = HeightRowz + TopPos
End With

Application.ScreenUpdating = True
 
If .Show = True Then
For Each objOpt In wsDlg.OptionButtons
If objOpt.Value = xlOn Then
optCaption = objOpt.Caption
Exit For
End If
Next objOpt
End If
 
If optCaption = "" Then
MsgBox "You did not select a worksheet.", 48, "Cannot continue"
Exit Sub
Else
 
MsgBox "You selected the sheet named ''" & optCaption & "''." & vbCrLf & "Click OK to go there.", 64, "FYI:"
Sheets(optCaption).Activate
 
End If
 
End If
 
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
 
End With

End Sub

 

[billy1989]

Thank you!

 

[billy1989]

Is there any way to reduce the space between the columns of sheets? The gap is very large as you can see in the screenshot!