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.
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
Rename it ComboWrapper
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
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.
