How do I create a drop down list that links other pages

[Barbara E]

I have a workbook in excell that has @80 sheets. I want to beable to find my
sheets without having to use the scrolling method. Can I create a drop down
list to will take me to the pages that I need.

 

[Frank Kabel]

Hi
see for something similar:
http://www.mvps.org/dmcritchie/excel/buildtoc.htm

 

[Bob Phillips]

Here is one way

Sub BrowseSheets()
Dim i As Integer
Dim TopPos As Integer
Dim iBooks As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As OptionButton
Application.ScreenUpdating = False

If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If

Set CurrentSheet = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add

iBooks = 0

TopPos = 40
For i = 1 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
iBooks = iBooks + 1
PrintDlg.OptionButtons.Add 78, TopPos, 150, 16.5
PrintDlg.OptionButtons(iBooks).Text = _
ActiveWorkbook.Worksheets(iBooks).Name
TopPos = TopPos + 13
Next i

PrintDlg.Buttons.Left = 240

CurrentSheet.Activate

With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 230
.Caption = "Select workbooks to process"
End With

PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront

Application.ScreenUpdating = True
If PrintDlg.Show Then
For Each cb In PrintDlg.OptionButtons
If cb.Value = xlOn Then
ActiveWorkbook.Worksheets(cb.Caption).Select
Exit For
End If
Next cb
Else
MsgBox "Nothing selected"
End If

Application.DisplayAlerts = False
PrintDlg.Delete

End Sub

 

[Gord Dibben]

Bob

This is a fine routine for up to 35 worksheets at my resolution.

Beyond that the option buttons are hidden.

Can you alter it so's you get more than one column of option buttons?

Thanks

Gord Dibben Excel MVP

 

[Bob Phillips]

Will do Gord, but will have to leave it until later today.

 

[Bob Phillips]

Here is a shot. I have defined some constants at the head of the code that
can facilitate tuning if required. Struggling to get a good algorithm to get
a sensible height regardless of the number of sheets, maybe someone else can
do better.

Sub BrowseSheets()
Const nPerColumn As Long = 35 'number of items per column
Const nWidth As Long = 7 'width of each letter
Const nHeight As Long = 18 'height of each row
Const sID As String = "___SheetGoto" 'name of dialog sheet
Const kCaption As String = " Select sheet to goto"
'dialog caption

Dim i As Long
Dim TopPos As Long
Dim iBooks As Long
Dim cCols As Long
Dim cLetters As Long
Dim cMaxLetters As Long
Dim iLeft As Long
Dim thisDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As OptionButton

Application.ScreenUpdating = False

If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If

On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(sID).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set CurrentSheet = ActiveSheet
Set thisDlg = ActiveWorkbook.DialogSheets.Add

With thisDlg

.Name = sID
.Visible = xlSheetHidden

'sets variables for positioning on dialog
iBooks = 0
cCols = 0
cMaxLetters = 0
cleft = 78
TopPos = 40

For i = 1 To ActiveWorkbook.Worksheets.Count

If i Mod nPerColumn = 1 Then
cCols = cCols + 1
TopPos = 40
cleft = cleft + (cMaxLetters * nWidth)
cMaxLetters = 0
End If

Set CurrentSheet = ActiveWorkbook.Worksheets(i)
cLetters = Len(CurrentSheet.Name)
If cLetters > cMaxLetters Then
cMaxLetters = cLetters
End If

iBooks = iBooks + 1
.OptionButtons.Add cleft, TopPos, cLetters * nWidth, 16.5
.OptionButtons(iBooks).Text = _
ActiveWorkbook.Worksheets(iBooks).Name
TopPos = TopPos + 13

Next i

.Buttons.Left = cleft + (cMaxLetters * nWidth) + 24

CurrentSheet.Activate

With .DialogFrame
.Height = Application.Max(68, _
Application.Min(iBooks, nPerColumn) * nHeight + 10)
.Width = cleft + (cMaxLetters * nWidth) + 24
.Caption = kCaption
End With

.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront

Application.ScreenUpdating = True
If .Show Then
For Each cb In thisDlg.OptionButtons
If cb.Value = xlOn Then
ActiveWorkbook.Worksheets(cb.Caption).Select
Exit For
End If
Next cb
Else
MsgBox "Nothing selected"
End If

Application.DisplayAlerts = False
.Delete

End With

End Sub

 

[Gord Dibben]

Bob

Gave it a good shot, I'd say.

A couple of small problems which I will relay to you via Email.

Thanks

Gord

 

[orrbill]

Bob

After you address the "couple of problems" that Gord is to relay to yo
via Email.

Will you be so kind to post your final version of the BrowseSheet
Macro to this thread. I really like what you have done and would reall
appreciate trying your final version.

Thanks,
Bill

 

[Bob Phillips]

Bill,

Gord's points were really about the width and height algorithms. I will try
and improve upon them. If you drop me your email address I will forward any
further solution direct to you.