Show Unique Values with other columns from excel sheet to Listbox

Question

I have data here that I want to get the unique values for Column C = Project ID.

Date      || Project ID || Implementation Area  || Start Time   || End Time     || Status
8/28/2023 || 1145544    || Arizona              || 8:00:03 AM   || 9:15:17 AM   || For Approval 1
8/28/2023 || 1157788    || Arizona              || 9:15:20 AM   || 12:00:19 PM  || For Approval 1
8/28/2023 ||LUNCH BREAK ||                      || 12:00:18 PM  || 1:00:00 PM   || LUNCH BREAK
8/29/2023 || 1145544    || Arizona              || 1:00:01 PM   || 3:00:00 PM   || For Approval 2
8/29/2023 || 1145544    || Arizona              || 3:30:07 PM   || 3:40:40 PM   || COMPLETED
8/30/2023 || 1157788    || Arizona              || 3:41:00 PM   || 3:50:00 PM   || For Approval 2
9/1/2023  || 1157788    || Arizona              || 4:00:00 PM   || 4:30:45 PM   || COMPLETED
9/2/2023  || 1233343    || New York             || 9:05:17 AM   || 11:30:20 AM  || For Approval 1
9/2/2023  ||LUNCH BREAK ||                      || 12:00:00 AM  || 1:00:00 PM   || LUNCH BREAK
9/2/2023  || 1233343    || New York             || 1:45:01 PM   || 2:45:30 PM   || For Approval 2
9/2/2023  || 1233343    || New York             || 3:00:00 AM   || 3:22:00 AM   || COMPLETED
9/2/2023  || 1422457    || Louisana             || 3:50:00 PM   || 4:12:00 PM   || For Approval 1
9/3/2023  || 1422457    || Louisana             || 10:18:03 AM  || 11:15:17 AM  || For Approval 2
9/4/2023  || 1422457    || Louisana             || 4:15:20 PM   || 4:35:19 PM   || COMPLETED

Now my code for getting the unique value/s is this:

Private Sub UserForm_Initialize() 
     
    Dim UniqueList()    As String 
    Dim x               As Long 
    Dim Rng1            As Range 
    Dim c               As Range 
    Dim Unique          As Boolean 
    Dim y               As Long 
     
    Set Rng1 = Sheets("Sheet1").Range("C:C") 
    y = 1 
     
    ReDim UniqueList(1 To Rng1.Rows.Count) 
     
    For Each c In Rng1 
        If Not c.Value = vbNullString Then 
            Unique = True 
            For x = 1 To y 
                If UniqueList(x) = c.Text Then 
                    Unique = False 
                End If 
            Next 
            If Unique Then 
                y = y + 1 
                Me.ListBox1.AddItem (c.Text) 
                UniqueList(y) = c.Text 
            End If 
        End If 
    Next 
     
End Sub

And this returns me unique values of column C.

Project ID
1145544
1157788
LUNCH BREAK
1233343
1422457

In my data provided, please notice that there are other columns. In the listbox, what I would like to achieve is this (no more lunch):

Date         Project ID   Status
8/29/2023    1145544      COMPLETED
9/1/2023     1157788      COMPLETED
9/2/2023     1233343      COMPLETED
9/4/2023     1422457      COMPLETED

Thanks in advance.

Answer 1

Dictionary object is a good choice to get the unique list.

For more detail, please refers to Microsoft document.

Dictionary object

Private Sub UserForm_Initialize()
    Dim Dic As Object, i, sKey, arr, aList()
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet1")
        ' load data into array
        arr = .Range(.[g2], .Cells(.Rows.Count, 2).End(xlUp))
        For i = 1 To UBound(arr)
            sKey = Trim(arr(i, 2))
            If Not UCase(sKey) = "LUNCH BREAK" Then
                If Dic.exists(sKey) Then
                    If arr(i, 1) >= Dic(sKey)(0) Then
                        Dic(sKey) = Array(arr(i, 1), Trim(arr(i, 6)))
                    End If
                Else
                    Dic(sKey) = Array(arr(i, 1), Trim(arr(i, 6)))
                End If
            End If
        Next
    End With
    ReDim aList(Dic.Count, 2)
    ' header row
    aList(0, 0) = "Date"
    aList(0, 1) = "Project ID"
    aList(0, 2) = "Status"
    i = 1
    ' transfer data from dict to array
    For Each sKey In Dic.keys
        aList(i, 0) = Dic(sKey)(0)
        aList(i, 1) = sKey
        aList(i, 2) = Dic(sKey)(1)
        i = i + 1
    Next
    ' populate ListBox
    With Me.ListBox1
        .ColumnCount = 3
        .List = aList
    End With
End Sub

---

Question: is there a way we can put numbered list in the listbox before the date column?

    ReDim aList(Dic.Count, 3)
    ' header row
    aList(0, 0) = "Index"
    aList(0, 1) = "Date"
    aList(0, 2) = "Project ID"
    aList(0, 3) = "Status"
    i = 1
    ' transfer data from dict to array
    For Each sKey In Dic.keys
        aList(i, 0) = i
        aList(i, 1) = Dic(sKey)(0)
        aList(i, 2) = sKey
        aList(i, 3) = Dic(sKey)(1)
        i = i + 1
    Next
    ' populate ListBox
    With Me.ListBox1
        .ColumnCount = 4
        .List = aList
    End With