DROP DOWN LIST

  • Thread starter Thread starter Dave
  • Start date Start date
D

Dave

Hi

I would like to create a drop down list if names that opens when the
spreadsheet opens so people can pick theyre own individual sheets.

How can this be done?

Thanks
 
No. This does not have the information Reza. I want to create a drop down
list in its own window when the sheet opens not one in a cell.

Thanks
 
Set the security level to low/medium in (Tools|Macro|Security). From workbook
press Alt+F11 to launch VBE (Visual Basic Editor). From the left treeview
search for the workbook name and click on + to expand it. Within that you
should see the following

VBAProject(Your_Filename)
Microsoft Excel Objects
Sheet1(Sheet1)
Sheet2(Sheet2)
Sheet3(Sheet3)
This Workbook

Double click 'This WorkBook' and paste the below code to the right code pane.

Private Sub Workbook_Open()
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In Me.Sheets
If ws.Index <> 1 Then ws.Visible = xlSheetHidden
UserForm1.ComboBox1.AddItem ws.Name
Next
Application.ScreenUpdating = True
UserForm1.Show
End Sub


Right click on the Workbook icon and add a user form...and place a combobox
and commandbutton..and right click 'Userform' View code and paste the below
code...Save and re-open the workbook

Private Sub CommandButton1_Click()
If Me.ComboBox1.Text <> "" Then
Sheets(Me.ComboBox1.Text).Visible = True
Sheets(Me.ComboBox1.Text).Activate
Unload Me
Else
MsgBox "Please select a sheet name"
End If
End Sub
 
In a general module in the workbook place the Browse_Sheets macro.

In Thisworkbook module place this event code.

Private Sub Workbook_Open()
Browse_Sheets
End Sub


Sub Browse_Sheets()
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


Gord Dibben MS Excel MVP
 
Back
Top