CODEWITHSUNDEEP
excelvbacomboboxlistbox
Shiela
Shiela

Reputation: 693

Show single month and year in combobox in Excel VBA and show listbox value during change

Please bear with me. I know that I already asked this but that was using Access VBA. This time I am using Excel VBA.

I have a sample range of dates below in Column A of Sheet1.

img1

I would like to achieve single months with year only. Image below has multiple months.

multiple

This is the code:

Dim ws As Worksheet, _
    Dic As Object, _
    rCell As Range, _
    Key


Set ws = Worksheets("Sheet1")
Set Dic = CreateObject("Scripting.Dictionary")
cmbMonth.Clear

For Each rCell In ws.Range("A2", ws.Cells(Rows.count, "A").End(xlUp))
    If Not Dic.exists(rCell.Value) Then
        Dic.Add rCell.Value, Nothing
    End If
Next rCell

For Each Key In Dic
    cmbMonth.AddItem Format(Key, "mmmm yyyy")
Next

Expected Output:

single

After selecting a month, second combobox will auto populate. I already have managed to let it autopopulate during Combobox1 change:

img2

Private Sub cmbMonth_Change()
Dim ws As Worksheet, _
    Dic As Object, _
    rCell As Range, _
    Key

Set ws = Worksheets("Sheet1")
Set Dic = CreateObject("Scripting.Dictionary")
Me.cmbName.Clear
Me.cmbName.Value = vbNullString

For Each rCell In ws.Range("B2", ws.Cells(Rows.count, "B").End(xlUp))
    If Format(rCell.Offset(0, -1), "mmmm yyyy") <> cmbMonth.Value Then
    Else
        If Not Dic.exists(rCell.Value) Then
            Dic.Add rCell.Value, Nothing
        End If
    End If
Next rCell

For Each Key In Dic
    cmbName.AddItem Key
Next
End Sub

Also would like to update listbox based on first and second comboboxes but only shows this below with no Columnheads:

wrong

Code is:

    Dim ws As Worksheet, rng As Range, count As Long, K As Long
    Dim arrData, arrList(), i As Long, j As Long
    Set ws = Worksheets("Sheet1")
    
    Set rng = ws.Range("A2:C" & ws.Cells(Rows.count, "A").End(xlUp).Row)
    arrData = rng.Value

    count = WorksheetFunction.CountIfs(rng.Columns(1), cmbMonth.Value, rng.Columns(2), cmbName.Value)
    ReDim arrList(1 To count + 1, 1 To UBound(arrData, 2))
    For j = 1 To UBound(arrData, 2)
        arrList(1, j) = arrData(1, j) 'the header
    Next
    K = 1
    For i = 2 To UBound(arrData)
        If arrData(i, 1) = cmbMonth.Value And arrData(i, 2) = cmbName.Value Then
            K = K + 1
            For j = 1 To UBound(arrData, 2)
               arrList(K, j) = arrData(i, j) 'matching data
            Next
        End If
    Next
    With Me.listName
        .ColumnWidths = "50,50,50"
        .ColumnCount = UBound(arrData, 2)
        .List = arrList
    End With

Please help of where I am getting wrong. Your help is greatly appreciated.

Upvotes: 0

Views: 48

Answers (1)

CDP1802
CDP1802

Reputation: 16322

Consider using a collection. The problem is with arrData(i, 1) = cmbMonth.Value which is comparing a date like 15/5/2024 with November 2024. Use Format(arrData(i, 1), "mmmm yyyy") = cmbMonth.Value.

    Dim ws As Worksheet, colList As Collection
    Dim arrData, arrList, i As Long, j As Long
    
    Set colList = New Collection
    Set ws = Worksheets("Sheet1")
    arrData = ws.Range("A1:C" & ws.Cells(ws.Rows.count, "A").End(xlUp).Row)
    
    ' build collection of row numbers
    For i = 2 To UBound(arrData)
        If Format(arrData(i, 1), "mmmm yyyy") = cmbMonth.Value And _
                  arrData(i, 2) = cmbName.Value Then
            colList.Add i, CStr(i)
        End If
    Next

    ReDim arrList(1 To colList.count + 1, 1 To UBound(arrData))
    ' header
    For j = 1 To 3
        arrList(1, j) = arrData(1, j) ' header
        For i = 1 To colList.count
            arrList(i + 1, j) = arrData(colList(i), j)
        Next
    Next

    With Me.listName
        .ColumnWidths = "50,50,50"
        .ColumnCount = UBound(arrData, 2)
        .List = arrList
    End With

Note instead of

For Each Key In Dic
    cmbName.AddItem Key
Next

you can use

cmbName.List = Dic.Keys

Upvotes: 2

Related Questions