CODEWITHSUNDEEP
excelcomboboxvba
Don Desrosiers
Don Desrosiers

Reputation: 143

Add identical code to multiple combo boxes

I have a worksheet with 960 combo boxes. I need them to all have the same code attached:

Private Sub ComboBox1_DropButtonClick()
ActiveSheet.Range("a2").Select
End Sub

is there a way to attach this code to each combo box on the sheet automatically without the tedious task of doing it one by one? In case it matters, the reason that I have attached this code is because when the combo box is selected, the hyperlinks and code on the sheet won't work until/unless the user clicks any cell. If there is a Properties setting that takes care of this, then I would rather do that.

Upvotes: 1

Views: 2763

Answers (2)

user6432984
user6432984

Reputation:

Create a ComboBox Collection

You'll need

  • Custom class ComboWrapper to hold a reference to you combobox
    • Using WithEvents you'll capture the buttons Click event
  • Module level collection variable to hold references to the ComboWrapper in memory
    • Use the Worksheet_Activate() to instantiate the collection

Insert a class

enter image description here

Rename it ComboWrapper

enter image description here

Insert this code into the ComboWrapper class

Public WithEvents combo As MSForms.ComboBox

Private Sub combo_Change()

    Range("A2").Select

End Sub

Insert this code into the Worksheet Code Module

Public ComboCollection As Collection

Private Sub Worksheet_Activate()
    Dim o As OLEObject
    Dim wrapper As ComboWrapper
    Set ComboCollection = New Collection

    For Each o In ActiveSheet.OLEObjects
        On Error Resume Next

        If o.progID = "Forms.ComboBox.1" Then
            Set wrapper = New ComboWrapper
            Set wrapper.combo = o.Object

            ComboCollection.Add wrapper
        End If

        On Error GoTo 0
    Next

End Sub

Upvotes: 1

Ralph
Ralph

Reputation: 9444

Since you are using ActiveX controls the name of the sub is preassigned. For example: if you click on the ComboBox1 then the name for the sub must be Private Sub ComboBox1_DropButtonClick() and the sub must be on the sheet where the ComboBox is located. So, if you have 960 ComboBoxes then you need to have 960 subs on the sheet where these ComboBoxes are located.

But here is the good news. You can use VBA to write the VBA code for you. The following sub will go through all sheets and all ActiveX ComboBoxes and write the code for you. Afterwards, the code is dropped into the Immediate window of the VBE.

Option Explicit

Public Sub GenerateComboBoxCode()

Dim ws As Worksheet
Dim obj As OLEObject
Dim strVBA As String

For Each ws In ThisWorkbook.Worksheets
    For Each obj In ws.OLEObjects
        If TypeName(obj.Object) = "ComboBox" Then
            strVBA = strVBA & "Private Sub " & obj.Name & "_DropButtonClick() " & Chr(10)
            strVBA = strVBA & "ActiveSheet.Range(""a2"").Select " & Chr(10)
            strVBA = strVBA & "End Sub " & Chr(10)
        End If
    Next obj
    Debug.Print "------------------------------------------------------"
    Debug.Print "--- Code for sheet " & ws.Name & ":"
    Debug.Print "------------------------------------------------------"
    Debug.Print strVBA
Next ws

End Sub

But in your case (960 ComboBoxes) the Immediate window might not be enough and you might have to store / save the VBA code on a sheet instead.

Update:

Since the Immediate window cannot fit the entire code, here is a little update to the above solution:

Option Explicit

Public Sub GenerateComboBoxCode()

Dim ws As Worksheet
Dim obj As OLEObject
Dim strVBA As String
Dim appWord As Object
Dim docWord As Object

For Each ws In ThisWorkbook.Worksheets
    strVBA = strVBA & "------------------------------------------------------" & Chr(10)
    strVBA = strVBA & "--- Code for sheet " & ws.Name & ":" & Chr(10)
    strVBA = strVBA & "------------------------------------------------------" & Chr(10)
    For Each obj In ws.OLEObjects
        If TypeName(obj.Object) = "ComboBox" Then
            strVBA = strVBA & "Private Sub " & obj.Name & "_DropButtonClick() " & Chr(10)
            strVBA = strVBA & "ActiveSheet.Range(""a2"").Select " & Chr(10)
            strVBA = strVBA & "End Sub " & Chr(10)
        End If
    Next obj
Next ws

Set appWord = CreateObject("Word.Application")
Set docWord = appWord.Documents.Add
docWord.Paragraphs.Add
docWord.Paragraphs(docWord.Paragraphs.Count).Range.Text = strVBA
appWord.Visible = True

End Sub

Now, a new Word Document is created and the entire code is copied into that word document. Afterwards, you can copy all of the document's content and paste it over into the sheet where the ComboBoxes reside.

Upvotes: 0

Related Questions