Create dependable dropdown of unique items in vba

Question

Using VBA, I want to produce a trustworthy drop-down with distinct items for Store and Region from the table in the below image in cells D4 and F4, respectively. The user initially chooses selections from the shop drop-down in cell D4 before selecting the options for the trustworthy region in cell F4.

I can design distinctive drop-down menus for shops and areas, but they are unreliable. Also, the manner I make the customised drop-down menu is ineffective.

Answer 1

Try this:

Sub UniqueList()

    Dim rng As Range, rng2 As Range
    Dim cell As Range, cell2 As Range
    Dim dict As Object, dict2 As Object
    Dim i As Long, j As Long

    Set dict = CreateObject("Scripting.Dictionary")
    Set dict2 = CreateObject("Scripting.Dictionary")

    Set rng = ActiveSheet.Range("A2", ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp))
    Set rng2 = ActiveSheet.Range("B2", ActiveSheet.Cells(ActiveSheet.Rows.Count, "B").End(xlUp))

    For Each cell In rng
        If Not dict.exists(cell.Value) Then
            dict.Add cell.Value, i
            i = i + 1
        End If
    Next cell

    For Each cell2 In rng2
        If Not dict2.exists(cell2.Value) Then
            dict2.Add cell2.Value, j
            j = j + 1
        End If
    Next cell2

    With ActiveSheet.Range("D4").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Join(dict.keys, ",")
    End With

    With ActiveSheet.Range("F4").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Join(dict2.keys, ",")
    End With

End Sub