Select page from listbox index

bilisim2010

New Member
Joined
Jan 17, 2025
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Hello everyone. I have a page named data in listbox index 4. When I click on the data in the listbox, it should open that page. What is the vba code for this?
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
In Sheet1 code module paste this :

VBA Code:
Option Explicit

Private Sub SheetSelector_Change()
    Dim selectedSheet As String
    Dim listBox As OLEObject
    Set listBox = Me.OLEObjects("SheetSelector")
    selectedSheet = listBox.Object.Value
    If selectedSheet <> "" Then
        Worksheets(selectedSheet).Activate
    End If
End Sub

In the ThisWorkbook module paste this :

Code:
Private Sub Workbook_Open()
    Dim ws As Worksheet
    Dim listBox As OLEObject
    Dim sheetNames As Collection
    Dim i As Long

    ' Initialize a collection to store worksheet names
    Set sheetNames = New Collection
    
    ' Loop through all sheets and add their names to the collection
    For Each ws In ThisWorkbook.Worksheets
        sheetNames.Add ws.Name
    Next ws

    ' Add a listbox to Sheet1 if not already present
    On Error Resume Next
    Set listBox = ThisWorkbook.Worksheets("Sheet1").OLEObjects("SheetSelector")
    On Error GoTo 0

    If listBox Is Nothing Then
        Set listBox = ThisWorkbook.Worksheets("Sheet1").OLEObjects.Add(ClassType:="Forms.ListBox.1", _
            Left:=10, Top:=10, Width:=150, Height:=100)
        listBox.Name = "SheetSelector"
    End If

    ' Populate the listbox with sheet names
    With listBox.Object
        .Clear
        For i = 1 To sheetNames.Count
            .AddItem sheetNames(i)
        Next i
    End With

    ' Assign the Change event handler if not already present
    Dim codeModule As Object
    Dim codeText As String
    Dim changeEventExists As Boolean
    Dim startLine As Long
    Dim endLine As Long

    Set codeModule = ThisWorkbook.VBProject.VBComponents(ThisWorkbook.Worksheets("Sheet1").CodeName).codeModule
    changeEventExists = False

    ' Check if the macro already exists
    With codeModule
        startLine = 1
        endLine = .CountOfLines
        codeText = .Lines(startLine, endLine)
        If InStr(1, codeText, "Private Sub SheetSelector_Change()", vbTextCompare) > 0 Then
            changeEventExists = True
        End If
    End With

    ' Add the macro only if it does not already exist
    If Not changeEventExists Then
        codeModule.AddFromString GetChangeEventCode()
    End If
End Sub

Private Function GetChangeEventCode() As String
    GetChangeEventCode = _
        "Private Sub SheetSelector_Change()" & vbCrLf & _
        "    Dim selectedSheet As String" & vbCrLf & _
        "    Dim listBox As OLEObject" & vbCrLf & _
        "    Set listBox = Me.OLEObjects(""SheetSelector"")" & vbCrLf & _
        "    selectedSheet = listBox.Object.Value" & vbCrLf & _
        "    If selectedSheet <> """" Then" & vbCrLf & _
        "        Worksheets(selectedSheet).Activate" & vbCrLf & _
        "    End If" & vbCrLf & _
        "End Sub"
End Function

This code, when the workbook is opened, checks for the presence of a ListBox control on Sheet1. If it doesn't exist, one is created and the workbook sheet names are populated in
the ListBox control. If the ListBox control exists then one is not created but the worksheet names are populated therein.

The macro also checks to see if the macro shown in the Private Function exists with Sheet1 code module. If it doesn't one is created ... which is required for the sheet selection
process to work.

The user simply clicks on a sheet name and is taken to that worksheets. Returning to Sheet1 is a manual process.
 
Upvote 0



 
Upvote 0
I had to use Google 'Translate' to interpret your response.

Are you pleased with the macro code ? Or do you require something more ?
 
Upvote 0

Forum statistics

Threads
1,226,456
Messages
6,191,144
Members
453,643
Latest member
adamb83

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top