Move/Copy ComboBox to different sheet while retaining code

Question

On Sheet1, I have an ActiveX combobox that lists the names of all the other sheets. When you select a sheet name, it runs the ComboBox1_Change event on the worksheet's code module, and that activates the desired sheet.

I'd like the destination sheet to have the same combobox so you can jump from there to yet another sheet. The obvious thing would be to make a copy of the combobox on every sheet, and copy the ComboBox1_Change code to every sheet's module.

I'd prefer to do this automatically if possible, because there are a lot of sheets. I'm pretty sure I can automatically move or copy the combobox to whatever sheet is selected (probably triggered on the Workbook_SheetActivate event). But what about the "jump to this sheet" code?

I need to either 1) automatically copy the code to each sheet, or 2) have the code in a central place where the combobox can run it from any sheet.

Answer 1

This ist the listbox-class that takes the worksheet within the init-sub. Then it is checked wether a combobox "lbSheetNames" exists - if not, it is created. Then the current sheet names are added to the list.

Generation of all listboxes takes place in the thisworkbook_activate-event - the objects are kept in a collection. Due to this routine it is not necessary to add code to the single worksheet.

class lbWorksheets

Option Explicit

Private Const lbName As String = "lbSheetNames"

Private m_ws As Worksheet
Private WithEvents m_cbo As MSForms.ComboBox

Public Sub init(ws As Worksheet)

    Set m_ws = ws
    
    addCombo
    fillCboWithSheetNames
    
End Sub

Private Sub addCombo()

    Dim objOLE As OLEObject, fFound As Boolean
    
    For Each objOLE In m_ws.OLEObjects
        If objOLE.Name = lbName Then
            fFound = True
            Exit For
        End If
    Next
    
    If fFound = False Then
        Set objOLE = m_ws.OLEObjects.Add("Forms.Combobox.1")
        With objOLE
            'change to your needs
            .Left = m_ws.Range("A1").Left
            .Top = m_ws.Range("A1").Top
            .Width = 150
            .Name = lbName
        End With
    End If
     
    With objOLE
        Set m_cbo = .Object
    End With

End Sub

Private Sub fillCboWithSheetNames()
Dim ws As Worksheet
m_cbo.List = Array()
For Each ws In ThisWorkbook.Worksheets
    If Not ws Is m_ws Then  'don't add current sheet to listbox
        m_cbo.AddItem ws.Name
    End If
Next
End Sub

Private Sub m_cbo_Change()
    gotoSheet m_cbo.Value
End Sub

Private Sub gotoSheet(wsName As String)

On Error GoTo err_gotoSheet
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(wsName)
    ws.Select
    
exit_gotoSheet:
    Exit Sub
err_gotoSheet:
    MsgBox "Sheet " & wsName & " does not exist.", vbExclamation
    Resume exit_gotoSheet
End Sub

Thisworkbook module

Option Explicit

Private m_colListboxes As Collection

Private Sub Workbook_Open()
iniListboxes
End Sub

Private Sub iniListboxes()
Dim ws As Worksheet, lb As lbWorksheets
Set m_colListboxes = New Collection
For Each ws In ThisWorkbook.Worksheets
    Set lb = New lbWorksheets
    lb.init ws
    m_colListboxes.Add lb
Next
End Sub