This is what I've come up with (for a start).
Put this code into a Class Module named clsQuadListBox.
It will create a custom object with three properties
Columns(index), Count, MultiSelect, ZFlowOrder
Columns will return the listbox associated with that index (0-based)
ZFlowOrder = True will give style A above, False gives style B
two methods, AddItem and Clear
and two Events Change and Click
Code:
' in clsQuadListBox class module
Public WithEvents Column0 As MSForms.ListBox
Public WithEvents Column1 As MSForms.ListBox
Public WithEvents Column2 As MSForms.ListBox
Public WithEvents Column3 As MSForms.ListBox
Public ZFlowOrder As Boolean
Dim clsEventsDisabled As Boolean
Event Change(ColumnIndex As Long)
Event Click(ColumnIndex As Long)
Public Sub AddItem(Item As Variant)
Dim i As Long, j As Long
If ZFlowOrder Then
For i = 1 To 3
With Me.Columns(i)
If .ListCount < Me.Columns(i - 1).ListCount Then
.AddItem CStr(Item)
Exit Sub
End If
End With
Next i
Me.Column0.AddItem CStr(Item)
Else
For i = 3 To 1 Step -1
With Me.Columns(i)
If .ListCount < Me.Columns(i - 1).ListCount Then
Exit For
End If
End With
Next i
If Me.Columns(i).ListCount = 0 Then
Me.Columns(i).AddItem CStr(Item)
Else
For j = i To 2
Me.Columns(j).AddItem Me.Columns(j + 1).List(0)
Me.Columns(j + 1).RemoveItem 0
Next j
Me.Column3.AddItem CStr(Item)
End If
End If
End Sub
Sub Clear()
With Me
.Column0.Clear
.Column1.Clear
.Column2.Clear
.Column3.Clear
End With
End Sub
Property Get Columns(Index As Long) As MSForms.ListBox
Select Case Index
Case 0: Set Columns = Column0
Case 1: Set Columns = Column1
Case 2: Set Columns = Column2
Case 3: Set Columns = Column3
End Select
End Property
Property Get MultiSelect() As fmMultiSelect
MultiSelect = Me.Column0.MultiSelect
End Property
Property Let MultiSelect(newMS As fmMultiSelect)
With Me
.Column0.MultiSelect = newMS
.Column1.MultiSelect = newMS
.Column2.MultiSelect = newMS
.Column3.MultiSelect = newMS
End With
End Property
Private Sub Class_Initialize()
ZFlowOrder = True
End Sub
Private Sub Column0_Click()
If clsEventsDisabled Then Exit Sub
Dim i As Long
With Me
If .MultiSelect = fmMultiSelectSingle Then
clsEventsDisabled = True
.Column1.ListIndex = -1
.Column2.ListIndex = -1
.Column3.ListIndex = -1
clsEventsDisabled = False
End If
End With
RaiseEvent Click(0)
End Sub
Private Sub Column1_Click()
If clsEventsDisabled Then Exit Sub
Dim i As Long
With Me
If .MultiSelect = fmMultiSelectSingle Then
clsEventsDisabled = True
.Column0.ListIndex = -1
.Column2.ListIndex = -1
.Column3.ListIndex = -1
clsEventsDisabled = False
End If
End With
RaiseEvent Click(1)
End Sub
Private Sub Column2_Click()
If clsEventsDisabled Then Exit Sub
Dim i As Long
With Me
If .MultiSelect = fmMultiSelectSingle Then
clsEventsDisabled = True
.Column0.ListIndex = -1
.Column1.ListIndex = -1
.Column3.ListIndex = -1
clsEventsDisabled = False
End If
End With
RaiseEvent Click(2)
End Sub
Private Sub Column3_Click()
If clsEventsDisabled Then Exit Sub
Dim i As Long
With Me
If .MultiSelect = fmMultiSelectSingle Then
clsEventsDisabled = True
.Column0.ListIndex = -1
.Column1.ListIndex = -1
.Column2.ListIndex = -1
clsEventsDisabled = False
End If
End With
RaiseEvent Click(3)
End Sub
Private Sub Column0_Change()
If clsEventsDisabled Then Exit Sub
RaiseEvent Change(0)
End Sub
Private Sub Column1_Change()
If clsEventsDisabled Then Exit Sub
RaiseEvent Change(1)
End Sub
Private Sub Column2_Change()
If clsEventsDisabled Then Exit Sub
RaiseEvent Change(2)
End Sub
Private Sub Column3_Change()
If clsEventsDisabled Then Exit Sub
RaiseEvent Change(3)
End Sub
This could be used in a user form like this. This code is for a user form with 4 list boxes (one for each column of the data) and four command buttons that drive testing routines.
one button toggles the ZFlowOrder (shown in the uf caption), one Adds many items to the QuadBox, one adds only one item to the quad box, one clears the quad box.
Try clearing the Quad box, change the ZFlowOrder and Add some items to see how the ZFlowOrder changes the order of the items.
Also, note the change event. The ColumnIndex is the (0 based) index of the column that is clicked. If the QuadBox is not multi-select (default) , then one can cleanly identify which row and which column was clicked.
Code:
' in userform code module
Public WithEvents QuadBox As clsQuadListBox
Private Sub UserForm_Initialize()
Set QuadBox = New clsQuadListBox
With QuadBox
Set .Column0 = Me.ListBox1
Set .Column1 = Me.ListBox2
Set .Column2 = Me.ListBox3
Set .Column3 = Me.ListBox4
End With
With Me
.Caption = QuadBox.ZFlowOrder
' label testing buttons
.CommandButton1.Caption = "Toggle ZFlowOrder"
.CommandButton2.Caption = "Clear"
.CommandButton3.Caption = "Add Many"
.CommandButton4.Caption = "Add One"
End With
End Sub
Rem Testing Routines
Private Sub CommandButton1_Click()
Rem toggle flow order
With QuadBox
.ZFlowOrder = Not .ZFlowOrder
Me.Caption = "ZFlowOrder = " & .ZFlowOrder
End With
End Sub
Private Sub CommandButton2_Click()
QuadBox.Clear
End Sub
Private Sub CommandButton3_Click()
Rem add many
Dim i As Long
With QuadBox
For i = .Count + 1 To .Count + 9
.AddItem i
Next i
End With
End Sub
Private Sub CommandButton4_Click()
Rem add one
With QuadBox
.AddItem (.Count + 1)
End With
End Sub
Rem Event Code
Private Sub QuadBox_Click(ColumnIndex As Long)
With QuadBox
If .MultiSelect = fmMultiSelectSingle Then
MsgBox "column " & (ColumnIndex + 1) & ", row" & (.Columns(ColumnIndex).ListIndex + 1)
Else
MsgBox "Column " & (ColumnIndex + 1) & " clicked"
End If
End With
End Sub
The class uses 0 based column and row indices (to match Excel's style). Note that the output from the change event is 1 based.
thanks though
