Macro to extract unique instance of multiple values in a column

[Kurt]

Hello All,

I found this old Mr. Excel post while doing a search:

https://www.mrexcel.com/forum/excel...nique-values-multiple-columns-one-column.html

I have modified the code for my purposes to this:

Sub ThreeColDupes()
Dim MyDict As Object, MyCols As Variant, OutCol As String, LastRow As Long
Dim InputSh As Worksheet, OutputSh As Worksheet
Dim x As Variant, i As Long, MyData As Variant

    Set MyDict = CreateObject("Scripting.Dictionary")

    Set InputSh = Sheets("Sheet2")
    MyCols = Array("A")
    'MyCols = Array("A", "G", "L")

    
    Set OutputSh = Sheets("Sheet2")
    OutCol = "D"
    
    For Each x In MyCols
        LastRow = InputSh.Cells(Rows.Count, x).End(xlUp).Row
        MyData = InputSh.Range(x & "1:" & x & LastRow).Value
        For i = 1 To UBound(MyData)
            If MyData(i, 1) <> "" Then MyDict(MyData(i, 1)) = 1
        Next i
    Next x

    OutputSh.Range(OutCol & "1").Resize(MyDict.Count, 1).Value = WorksheetFunction.Transpose(MyDict.Keys)
    
End Sub

My data is stored on a worksheet called DataCalcs.

The data I need the unique identifier on is in column AG on the DataCalcs page like this:

Altern 1
Altern 1
Altern 1
Altern 1
Altern 1
Altern 1
2
2
2
2
2
2
22
Base
Base
Base
Base
Base
Base
Base
Base
Base
Base
Base
Base
Base


Of course the data is 29 thousand plus rows.

I then want to attach this code to a menu item I have created on the ribbon to recognize the unique identifier in Column AG and display those items in the DataCalcs worksheet like using the Filter button.

 

[Kurt]

Extract unique values when one item is selected display the value set on the same worksheet like filter

This is almost what I need:

Public Sub Populate_combobox_with_Unique_values()
'Updateby Extendoffice 20160913
    Dim vStr, eStr
    Dim dObj As Object
    Dim xRg As Range
    On Error Resume Next
    Set dObj = CreateObject("Scripting.Dictionary")
    Set xRg = Application.InputBox("Range select:", "Kutools for Excel", _
                                    ActiveWindow.RangeSelection.AddressLocal, , , , , 8)
    vStr = xRg.Value
    Application.ScreenUpdating = False
    With dObj
        .comparemode = 1
        For Each eStr In vStr
            If Not .exists(eStr) And eStr <> "" Then .Add eStr, Nothing
        Next
        If .Count Then
            ActiveSheet.ComboBox1.List = WorksheetFunction.Transpose(.keys)
        End If
    End With
    Application.ScreenUpdating = True
End Sub

I found this code here: https://www.extendoffice.com/documents/excel/4023-excel-combobox-unique-values-only.html

When an item is selected, I need the values to be displayed on the worksheet while keeping all the other data just like a Filter.