Goto Dialog Box via VBA

Ho Hock
Have you tried navigating by right clicking on any of the navigation arrows in the bottom left-hand corner and selecting the sheet you want from the list that appears?
Celia

*****

Hello Celia,

Yes, indeed I've been using that function for smaller workbooks but I am just hoping to be able to create that dialog box, which will really be great.

Could you please help?

Thank you very much in advance.

Best regards,
Hdoong.

Hdoong

Sub Activate_Worksheet()
Dim sh As String
sh = InputBox("Enter the sheet to be activated")
On Error GoTo e
Worksheets(sh).Activate
Exit Sub
e: MsgBox "There is no sheet named " & """" & sh & """"
End Sub

Celia

Hdoong
I was intrigued by the Q....so I made a routine
based on one J Walkenbacks routines.
Basically this will create a Userform on the fly
with a combobox (for selecting or typing the sheet name) and 3 buttons, Cancel, Go and Back.
If interested then post and I'll either post code
here or send you example.

Ivan

Ivan
Would appreciate if you could post it. (I considered doing similar but wasn't intrigued enough to summon the effort!!).
Celia

Celia
A bit long winded BUT here goes.

'Discription: Creates a UserFrom on the fly
'Userform contains Combobox and 3 buttons
'ComboBox used to select via dropdown or typing,
'The sheet to goto.
'Buttons to Cancel, Goto sheet, Go back to last
'selected sheet.

'Userform is deleted after use.

'Upon opening the file a button is created
'that will call the creation of the form with it's
'buttons.......Combobox had to be filled via
'userform initialise ?? couldn't get it ??

Ivan

Code in Thisworkbook object;

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Delete_Button
End Sub

Private Sub Workbook_Open()
Create_Button
End Sub

'Used to create a button to call the routine
'So it can be used in any workbook that is open.

Code to go into a seperaate Module;

'This code handles the Back button, note
'it is robust enough to handle or use for
'any routine in which a return from is required.

Public Sub SaveLocation(ReturnToLoc As Boolean)

Static WB As Workbook
Static WS As Worksheet
Static Rg As Range

On Error GoTo NoGo
If ReturnToLoc = False Then
Set WB = ActiveWorkbook
Set WS = ActiveSheet
Set Rg = Selection
Else
WB.Activate
WS.Activate
Rg.Select
End If

Exit Sub
NoGo:
MsgBox "Not set !"
End Sub

'To save the current location, call SetSaveLoc.

Public Sub SetSaveLoc()
SaveLocation (False)
End Sub

'To return to the saved location, call GetSaveLoc.

Public Sub GetSaveLoc()
SaveLocation (True)
End Sub

Routines to go into a seperate Module;

Option Base 1
'Passed back to the function from the UserForm
Public GETOPTION_RET_VAL As Variant

Function GetOption(Title)
Dim TempForm
Dim NewComboBox As MSForms.ComboBox
Dim NewCommandButton1 As MSForms.CommandButton
Dim NewCommandButton2 As MSForms.CommandButton
Dim NewCommandButton3 As MSForms.CommandButton
Dim X As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim ShName()

' Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False

' Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 300

' Add the ComBoBox
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
Set NewComboBox = TempForm.Designer.Controls.Add("forms.combobox.1")
With NewComboBox
.Width = 200
.Height = 15
.Left = 8
.Top = TopPos
If .Width > MaxWidth Then MaxWidth = .Width
End With

' Add the Cancel button
Set NewCommandButton1 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With

' Add the GO button
Set NewCommandButton2 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "GO"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With

' Add the Back button
Set NewCommandButton3 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton3
.Caption = "< Back"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 50
End With

' Add event-hander subs for the CommandButtons
With TempForm.CodeModule
X = .CountOfLines
.insertlines X + 0, "Option Base 1"
.insertlines X + 1, "Sub CommandButton1_Click()"
.insertlines X + 2, " GETOPTION_RET_VAL=False"
.insertlines X + 3, " Unload Me"
.insertlines X + 4, "End Sub"

.insertlines X + 5, "Sub CommandButton2_Click()"
.insertlines X + 6, " SetSaveloc"
.insertlines X + 7, " Sheets(ComboBox1.Text).Activate"
.insertlines X + 8, "End Sub"
.insertlines X + 9, "Private Sub UserForm_Initialize()"
.insertlines X + 10, "Dim ShName(),X as Integer"
.insertlines X + 11, "ReDim ShName(Sheets.Count)"
.insertlines X + 12, "For X = 1 To Sheets.Count"
.insertlines X + 13, " ShName(X) = Sheets(X).Name"
.insertlines X + 14, "Next"
.insertlines X + 15, "ComboBox1.List() = ShName()"
.insertlines X + 16, "SetSaveLoc"
.insertlines X + 17, "End Sub"
.insertlines X + 18, "Sub CommandButton3_Click()"
.insertlines X + 19, "GetSaveLoc"
.insertlines X + 20, "End Sub"
.insertlines X + 21, ""
End With

' Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = 24 * 4 'no buttons + 1
End With

' Show the form
VBA.UserForms.Add(TempForm.Name).Show

' Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm

' Pass the selected option back to the calling procedure
GetOption = GETOPTION_RET_VAL
End Function

Sub GotoSheet()
Dim UserChoice As Variant

UserChoice = GetOption("Select a Sheet")
If UserChoice = False Then End

End Sub

Sub Create_Button()
Dim TopButton As CommandBarButton
Set TopButton = Application.CommandBars(1).Controls.Add(Type:=msoControlButton, _
Before:=10)
With TopButton
.Style = msoButtonCaption
.Caption = "GoTo Sheet"
.OnAction = "GotoSheet"
End With
End Sub

Sub Delete_Button()
Application.CommandBars(1).Controls("GoTo Sheet").Delete
End Sub

Thanks

Dear Ivan,

Thank you very much for your reply. Looking at the code, I feel that this is what I hope to do but I tried it but could not get the results. It is very likely that I code it incorrectly as I am a very weak with VBA.

Do I have to create a user form, add a combo box and then insert 3 buttons and then assign the codes to the buttons? Or how do I do it?

Thank you very much for your advice and help.

Best regards,
Hock-doong.

Hdoong Sub Activate_Worksheet() Dim sh As String sh = InputBox("Enter the sheet to be activated") On Error GoTo e Worksheets(sh).Activate Exit Sub e: MsgBox "There is no sheet named " & """" & sh & """" Celia

Dear Celia,

Thank you so very much for the code. It works perfectly well.

It amazes me what Excel can do and the skills that members of this forum has. It's really amazing!.. :-)

Thank you once again.

Best regards,
Hock-doong.

Dear Ivan, Thank you very much for your reply. Looking at the code, I feel that this is what I hope to do but I tried it but could not get the results. It is very likely that I code it incorrectly as I am a very weak with VBA. Do I have to create a user form, add a combo box and then insert 3 buttons and then assign the codes to the buttons? Or how do I do it? Thank you very much for your advice and help. Hock-doong.

Best if I send you the workbook

Ivan

Slight Adj to code due to error when invalid sheet name

Main routine to be adj.

Function GetOption(Title)
Dim TempForm
Dim NewComboBox As MSForms.ComboBox
Dim NewCommandButton1 As MSForms.CommandButton
Dim NewCommandButton2 As MSForms.CommandButton
Dim NewCommandButton3 As MSForms.CommandButton
Dim X As Integer, TopPos As Integer
Dim MaxWidth As Long, Ams As String, Ap As String
Dim ShName()

' Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False

' Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 300

' Add the ComBoBox
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
Set NewComboBox = TempForm.Designer.Controls.Add("forms.combobox.1")
With NewComboBox
.MatchEntry = fmMatchEntryFirstLetter
.Width = 200
.Height = 15
.Left = 8
.Top = TopPos
If .Width > MaxWidth Then MaxWidth = .Width
End With

' Add the Cancel button
Set NewCommandButton1 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With

' Add the GO button
Set NewCommandButton2 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "GO"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With

' Add the Back button
Set NewCommandButton3 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton3
.Caption = "< Back"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 50
End With

Ap = Chr(34): Ams = Chr(38)
' Add event-hander subs for the CommandButtons
With TempForm.CodeModule
X = .CountOfLines
.insertlines X + 0, "Option Base 1"

.insertlines X + 1, "Sub CommandButton1_Click()"
.insertlines X + 2, " GETOPTION_RET_VAL=False"
.insertlines X + 3, " Unload Me"
.insertlines X + 4, "End Sub"

.insertlines X + 5, "Sub CommandButton2_Click()"
.insertlines X + 6, " SetSaveloc"
.insertlines X + 7, " On Error Resume Next"
.insertlines X + 8, " Sheets(ComboBox1.Text).Activate"
.insertlines X + 9, " If Err.Number <> 0 Then MsgBox " & _
Ap & "Sheet " & Ap & Ams & " ComboBox1.Text " & Ams & Ap & " doesn't exists!"
.insertlines X + 10, "End Sub"

.insertlines X + 11, "Private Sub UserForm_Initialize()"
.insertlines X + 12, "Dim ShName(),X as Integer"
.insertlines X + 13, "ReDim ShName(Sheets.Count)"
.insertlines X + 14, "For X = 1 To Sheets.Count"
.insertlines X + 15, " ShName(X) = Sheets(X).Name"
.insertlines X + 16, "Next"
.insertlines X + 17, "ComboBox1.List() = ShName()"
.insertlines X + 18, "SetSaveLoc"
.insertlines X + 19, "End Sub"

.insertlines X + 20, "Sub CommandButton3_Click()"
.insertlines X + 21, "GetSaveLoc"
.insertlines X + 22, "End Sub"

End With

' Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = 24 * 4 'no buttons + 1
End With

' Show the form
VBA.UserForms.Add(TempForm.Name).Show

' Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm

' Pass the selected option back to the calling procedure
GetOption = GETOPTION_RET_VAL
End Function

Sub GotoSheet()
Dim UserChoice As Variant

UserChoice = GetOption("Select a Sheet")
If UserChoice = False Then End

End Sub