Dynamic Combo Boxes won't fire event directly after creation 1

[ZenRaven]

I created a class module with events to be able to create comboboxes at runtime. I create one combobox in A2 when the workbook is opened. Once a selection is made in that box, another is created in the cell directly below it. The problem comes in that the events on the newly created object will not fire until I shift the focus off of the object and then go back to it. It even happens on the first one that is created when the workbook is opened. If I click the dropdown without clicking somewhere else first, no events fire. Even subsequent selections from the object don't fire until I shift the focus. After focus is shisfted manually, it works like a charm. I thought I could get around this by selecting an adjacent cell in vba directly after object creation but it didn't work. It only works if I do it manually. Anybody know why this is happening and how to fix it?

 

[SkipVought]

Hi,

And do you think that posting your code might help someone to understand what is really happening, rather than guessing?

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[ZenRaven]

Yeah, sorry. Here's the relevant pieces. I wanted to just upload the file to make things easier but I'm not giving my cc number to the box.net people


clsComboBoxEvents class module

Option Explicit

Dim WithEvents CmbBox As MSForms.ComboBox
Dim WithEvents ChkBox As MSForms.CheckBox

Dim OldCmbName As String
Dim OldCmbValue As String

Public Property Set Ctl(theCtl As Object)
    If TypeName(theCtl) = "CheckBox" Then
        Set ChkBox = theCtl
    ElseIf TypeName(theCtl) = "ComboBox" Then
        Set CmbBox = theCtl
    End If
End Property


Private Sub CmbBox_Click()
  'MsgBox "OldValue=" & cmbName & ":" & cmbValue & " NewValue=" & CmbBox.Name & ":" & CmbBox.Value


  Dim NewCmbValue As String
  Dim o As OLEObject
  Dim r As Integer
  Dim c As Integer
  'Dim ObjLink As String
  Dim ObjRange As Range
  Dim NextCmb As String
  Dim SelSheet As Worksheet
  
  Set SelSheet = Worksheets("Selections")
  
  If IsNull(CmbBox.Value) Then
    NewCmbValue = ""
  Else
    NewCmbValue = CmbBox.Value
  End If
  
  Set ObjRange = Range(CmbBox.LinkedCell)
  
  c = ObjRange.Column
  r = ObjRange.Row
  
  OldCmbValue = SelSheet.Cells(r, c).Value
  
  'MsgBox NewCmbValue & " : " & OldCmbValue
  
  If NewCmbValue = OldCmbValue Then Exit Sub
  
  If c = 1 Then
    NextCmb = CmbObjExists(ObjRange.Offset(1, 0))
    If NewCmbValue = "" And NextCmb <> "" Then
      RemoveComboBoxes ActiveSheet, r
      ObjRange.EntireRow.Delete
    ElseIf NextCmb = "" Then
      Set o = AddComboBoxes(ActiveSheet, r + 1, 1)
      o.ListFillRange = "ValidGLN"
      Set o = AddComboBoxes(ActiveSheet, r + 1, 6)
      With o
        .ListFillRange = "Categories"
        .Object.ColumnWidths = "0 pt;0 pt"
        .Object.ColumnCount = 3
      End With
      HideComboBoxes ActiveSheet, r, c
    End If
  End If
  
  SelSheet.Cells(r, c).Value = ActiveSheet.Cells(r, c).Value
  
  ActiveSheet.Cells(r + 1, c).Select

End Sub

'Private Sub CmbBox_DropButtonClick()
'
'MsgBox "click!!!"
'
'End Sub

WorkBook

Private Sub Workbook_Open()

'On Error Resume Next

Worksheets("Categories").Visible = False
Worksheets("GLN").Visible = False
Worksheets("ListRefs").Visible = False
Worksheets("Selections").Visible = False

Names.Add Name:="ValidGLN", RefersToR1C1:="=GLN!R1C1:R" & Range("GLN!A65536").End(xlUp).Row & "C1"
Names.Add Name:="CatParents", RefersToR1C1:="=Categories!R2C2:R" & Range("Categories!B65536").End(xlUp).Row & "C2"
Names.Add Name:="ValidCats", RefersToR1C1:="=ListRefs!R1C1:R" & Range("ListRefs!A65536").End(xlUp).Row & "C1"
Names.Add Name:="Categories", RefersToR1C1:="=Categories!R2C1:R" & Range("Categories!A65536").End(xlUp).Row & "C3"


Dim mysheet As Worksheet
Dim o As OLEObject

Set mysheet = Sheets("VendorInitiate")

Set o = AddComboBoxes(mysheet, 2, 1)
o.ListFillRange = "ValidGLN"
Set o = AddComboBoxes(mysheet, 2, 6)
With o
  .ListFillRange = "Categories"
  .Object.ColumnWidths = "0 pt;0 pt"
  .Object.ColumnCount = 3
End With
        
End Sub

Sheet1(VendorInitiate)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

On Error Resume Next

Dim CmbName As String
Dim prevCmbName As String
Dim prevCmbValue As String

If Target.Count > 1 Then Exit Sub

'MsgBox PrevSelection.Address & " > " & Target.Address

CmbName = CmbObjExists(Target)
prevCmbName = CmbObjExists(PrevSelection)

prevCmbValue = PrevSelection.Value

If prevCmbName <> "" And prevCmbValue <> "" Then
  ActiveSheet.OLEObjects(prevCmbName).Visible = False
End If


If CmbName <> "" Then
  ActiveSheet.OLEObjects(CmbName).Visible = True
End If

collCtls

Set PrevSelection = Selection

End Sub

Module1

Dim MyComboBoxEvents As clsComboBoxEvents
Dim myCollection As Collection

Function AddComboBoxes(aSheet As Worksheet, r As Integer, c As Integer) As OLEObject
    Dim cb As OLEObject
    Dim aCell As Range
    
    Set aCell = Cells(r, c)
   
        Set cb = aSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", _
                                       Left:=aCell.Left + 1, Top:=aCell.Top + 1, _
                                       Width:=aCell.Width, Height:=aCell.Height)
        cb.Placement = 1 '-- move and resize with cell
        'cb.Name = "ComboBoxR" & r & "C" & c
        cb.LinkedCell = aCell.Address
        cb.Object.SpecialEffect = 0
        cb.Object.BorderStyle = 1
        'cb.Object.ShowDropButtonWhen = 1
        
        Set AddComboBoxes = cb
        
End Function

Function RemoveComboBoxes(aSheet As Worksheet, r As Integer, Optional c As Integer = 0)
  Dim ObjLink As String
  Dim obj As OLEObject

  If c = 0 Then
    ObjLink = "$*$" & r
  Else
    ObjLink = Cells(r, c).Address
  End If
  
  For Each obj In aSheet.OLEObjects
    If obj.LinkedCell Like ObjLink Then
      aSheet.OLEObjects(obj.Name).Delete
    End If
  Next

End Function

Function HideComboBoxes(aSheet As Worksheet, r As Integer, c As Integer)
  Dim ObjLink As String
  Dim obj As OLEObject

  ObjLink = Cells(r, c).Address
  
  For Each obj In aSheet.OLEObjects
    If obj.LinkedCell Like ObjLink Then
      aSheet.OLEObjects(obj.Name).Visible = False
    End If
  Next
End Function

Function CmbObjExists(aRange As Range) As String
  Dim obj As OLEObject
  
  For Each obj In ActiveSheet.OLEObjects
    If obj.LinkedCell = aRange.Address Then
      CmbObjExists = obj.Name
      Exit Function
    End If
  Next
  
End Function

Function CmbObjLink(aName As String) As Range
  Dim obj As OLEObject
  
  Set obj = ActiveSheet.OLEObjects(aName)
  
  Set CmbObjLink = Range(obj.LinkedCell)
  
End Function

Sub collCtls()
Dim oleObj As OLEObject
    Set myCollection = New Collection
    For Each oleObj In ActiveSheet.OLEObjects
        Set MyComboBoxEvents = New clsComboBoxEvents
        Set MyComboBoxEvents.Ctl = oleObj.Object
        myCollection.Add MyComboBoxEvents, oleObj.Name
    Next
End Sub

 

[SkipVought]

Is there a reason why you are creating the controls at run time?

Since you only have 2 controls, why not place them on the sheet, and control their visibility, position & size at run time? Would be much simpler.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[ZenRaven]

I'm creating them at runtime because there will be a variable number of rows that will contain these boxes. A user will select an item from the box (source being a named range from another sheet) and fill in information about that item along the row. There is another box in F that I am going to do the same "box creation" with but it will produce new objects horizontally and their sources will be a filtered range dependent on the box to their left. There could potentially be hundreds or *sigh* thousands of these checboxes depending on how many items a user wants to modify and how many attributes each individual item has.

 

[SkipVought]

You do not need a box for each row of data. In fact you only need ONE combobox!

When the user selects a cell in the defined range, make the control visible, position it with the TOP & LEFT property of the selected cell and size it with the cells WIDTH & HEIGHT.

When the user makes a selection, use the control's change event to place the selected value in the cell and make the control invisible.

That's the drill.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[ZenRaven]

hahahah, boy do I feel dumb. I didn't think that would work for the other box because of the dynamic ranges but I guess just as long as I grab the value from the appropriate cell to filter off of, it should work.

Now I'm gonna tell you something you already know... You Rock!

 

[SkipVought]

Yes, I failed to mention assigning the appropriate Fill Range depending on the CONTEXT.

Thanks!

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}