drop-down lists and VBA code

G

Guest

I have about 50 worksheets in one workbook. I’ve created a “homepage†that
has a drop-down list. In the drop-down list are values that represent each
of the 50 worksheets. I’d like to create a module/function that will take me
to the appropriate worksheet when its worksheet title is selected in the
drop-down list.
Would someone be willing to share the code that would allow me to do what
I’m looking to do?
I’d greatly appreciate any assistance!
 
G

Guest

Right click on the worksheet tab and select VIEW SOURCE.

Paste this code in. Change as labeled

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myWS As Worksheet

If Not Intersect(Target, Range("A1")) Is Nothing Then '<~~~~change A1 as
needed
Set myWS = Nothing
On Error Resume Next
Set myWS = Worksheets(Target.Value)
On Error GoTo 0
If Not myWS Is Nothing Then
myWS.Activate
Else
MsgBox ("Worksheet " & Target.Value & " does not exist in the
workbook.")
End If
End If

End Sub

HTH,
Barb Reinhardt
 
G

Gord Dibben

How will you get back to the "homepage" after going to one of the 50 other
sheets?

I prefer Bob Phillips' browsesheet code to go to any sheet in the workbook.

Sub BrowseSheets()
Const nPerColumn As Long = 38 'number of items per column
Const nWidth As Long = 13 '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 cLeft 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

NOTE: Gary Brown revised this code to cover hidden sheets and chart sheets and
other potential problems.

See this thread for that revised code.

http://snipurl.com/1l8o4

I would make one more change to Gary's code.

Const nWidth As Long = 8 'width of each letter
Change to 10 or sheetnames < 4 chars will be incomplete


Gord Dibben MS Excel MVP
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top