Hi again McC and Howdy Brian as well
No apologies; IMO, this is one of the great things about vbax. We get to see different ways of 'skinning the cat'.
Well... the "not 'getting' it" turned out to be awfully lengthy, but other than a small fire and lights occassionally dimming when F5 was pushed...
Okay, here's probably my first stab at using a class without following someone's example. I greatly suspect that efficiency and/or better localizing of the dictionaries could be accomplished, but it seems tobe working. (I am trying not to sound suprised, but was getting awfully frustrated for a bit.)
In a Class Module named clsPerson:
Option Explicit
Public WithEvents PersonGroup As MSForms.ComboBox
Function UpdateUsed(fra As MSForms.Frame, dic As Object)
Dim cbo As MSForms.ComboBox
Dim i As Long
Dim ary As Variant
DicUsed.RemoveAll
For Each cbo In fra.Controls
If Not cbo.ListIndex = -1 And Not cbo.Value = vbNullString Then
DicUsed.Item(cbo.Value) = cbo.Value
End If
Next
ary = dic.Keys
DicTmp.RemoveAll
For i = LBound(ary) To UBound(ary)
If Not DicUsed.Exists(CStr(ary(i))) Then DicTmp.Item(CStr(ary(i))) = CStr(ary(i))
Next
End Function
Private Sub PersonGroup_Change()
Dim ctl As MSForms.Control
Dim fra As MSForms.Frame
Set ctl = PersonGroup
Select Case True
Case ctl.Name Like "cboName*"
Set fra = frmDrawResults.fraName
Call UpdateUsed(fra, DicName)
Call UpdateLists(fra)
Case ctl.Name Like "cboDriver*"
Set fra = frmDrawResults.fraDriver
Call UpdateUsed(fra, DicDriver)
Call UpdateLists(fra)
Case ctl.Name Like "cboQF*"
Set fra = frmDrawResults.fraQF
Call UpdateUsed(fra, DicQF)
Call UpdateLists(fra)
Case ctl.Name Like "cboFin*"
Set fra = frmDrawResults.fraFin
Call UpdateUsed(fra, DicFin)
Call UpdateLists(fra)
End Select
End Sub
Function UpdateLists(fra As MSForms.Frame)
Dim tmpVal As String
Dim cbo As MSForms.ComboBox
If Not PersonGroup.ListIndex = -1 And Not PersonGroup.Value = vbNullString Then
tmpVal = PersonGroup.Value
If DicTmp.Exists(PersonGroup.Value) Then DicTmp.Remove (PersonGroup.Value)
PersonGroup.List = DicTmp.Keys
PersonGroup.AddItem tmpVal, 0
PersonGroup.ListIndex = 0
Else
PersonGroup.List = DicTmp.Keys
PersonGroup.ListIndex = -1
End If
For Each cbo In fra.Controls
If Not cbo.Name = PersonGroup.Name Then
If Not cbo.ListIndex = -1 And Not cbo.Value = vbNullString Then
tmpVal = cbo.Value
cbo.List = DicTmp.Keys
cbo.AddItem tmpVal, 0
cbo.ListIndex = 0
Else
cbo.List = DicTmp.Keys
cbo.ListIndex = -1
End If
End If
Next
End Function
In a Standard Module:
Option Explicit
Public DicName As Object
Public DicDriver As Object
Public DicQF As Object
Public DicFin As Object
Public DicUsed As Object
Public DicTmp As Object
Dim PersonBox() As New clsPerson
Sub AutoShape1_Click()
Call PrepDialog
End Sub
Sub PrepDialog()
Dim _
cbo As MSForms.ComboBox, _
lPersonCount As Long, _
rng As Range, _
Cell As Range
Set DicName = CreateObject("Scripting.Dictionary")
Set DicDriver = CreateObject("Scripting.Dictionary")
Set DicQF = CreateObject("Scripting.Dictionary")
Set DicFin = CreateObject("Scripting.Dictionary")
Set DicUsed = CreateObject("Scripting.Dictionary")
Set DicTmp = CreateObject("Scripting.Dictionary")
Set rng = Sheet1.Range("Person")
For Each Cell In rng
DicName.Item(Cell.Value) = CStr(Cell.Value)
Next
Set rng = Sheet1.Range("Driver")
For Each Cell In rng
DicDriver.Item(Cell.Value) = CStr(Cell.Value)
Next
Set rng = Sheet1.Range("QFPos")
For Each Cell In rng
DicQF.Item(Cell.Value) = CStr(Cell.Value)
Next
Set rng = Sheet1.Range("FinPos")
For Each Cell In rng
DicFin.Item(Cell.Value) = CStr(Cell.Value)
Next
lPersonCount = 0
For Each cbo In frmDrawResults.fraName.Controls
lPersonCount = lPersonCount + 1
ReDim Preserve PersonBox(1 To lPersonCount)
Set PersonBox(lPersonCount).PersonGroup = cbo
PersonBox(lPersonCount).PersonGroup.List = DicName.Keys
Next
For Each cbo In frmDrawResults.fraDriver.Controls
lPersonCount = lPersonCount + 1
ReDim Preserve PersonBox(1 To lPersonCount)
Set PersonBox(lPersonCount).PersonGroup = cbo
PersonBox(lPersonCount).PersonGroup.List = DicDriver.Keys
Next
For Each cbo In frmDrawResults.fraQF.Controls
lPersonCount = lPersonCount + 1
ReDim Preserve PersonBox(1 To lPersonCount)
Set PersonBox(lPersonCount).PersonGroup = cbo
PersonBox(lPersonCount).PersonGroup.List = DicQF.Keys
Next
For Each cbo In frmDrawResults.fraFin.Controls
lPersonCount = lPersonCount + 1
ReDim Preserve PersonBox(1 To lPersonCount)
Set PersonBox(lPersonCount).PersonGroup = cbo
PersonBox(lPersonCount).PersonGroup.List = DicFin.Keys
Next
frmDrawResults.Show
End Sub
You will note that like Brian, I ditched the RowSource. I also used a Frame control around each group of ComboBoxes. While trying several different ways (mostly with remarkable failure), it struck me that just looping through the controls in the group would be faster than looping through all the controls on the form. If you don't like frames, you could use the Like statement in a larger sense than I did.
Hope this helps,
Mark
Reply With Quote
Originally Posted by youngmcc
.
