Getting unique values for multiple column separatly

Question

What is worng with my function its loading the two different column A and B and pasting the unique values of column A into Column M and N.

I want to repeat this function for the 7 columns.

I would appreciate your help in this regards.

Sub GetUniques()

Dim d As Object, c As Variant, i As Long, lr As Long, lr2 As Long, lr3 As Long, lr4 As Long, lr5 As Long, lr6 As Long
Set d = CreateObject("Scripting.Dictionary")

lr = Cells(Rows.Count, 1).End(xlUp).Row
c = Range("A2:A" & lr)

lr2 = Cells(Rows.Count, 2).End(xlUp).Row
e = Range("B2:B" & lr2)

For i = 1 To UBound(c, 1)
  d(c(i, 1)) = 1
Next i

For i = 1 To UBound(e, 1)
  d(e(i, 1)) = 1
Next i

Range("M2").Resize(d.Count) = Application.Transpose(d.keys)
Range("N2").Resize(d.Count) = Application.Transpose(d.keys)
End Sub

Which version excel do you use. In Excel 365 there is a built in UNIQUE-function — Ike, Aug 01 '22 at 19:19
Yes i am using Excel 365 but [After using this function](https://stackoverflow.com/questions/73025770/how-to-add-more-header-in-the-code-to-extract-the-data) i have to get unique values for each of column. using VBA — HSHO, Aug 01 '22 at 19:20
This may be of interest: https://stackoverflow.com/questions/62204826/excel-unique-across-columns — urdearboy, Aug 01 '22 at 19:30
Hey thank you @urdearboy but its not relatable because i want each column unique values to be pasted in separate column, For Example Column `A,B,C,D,E` unique values will pasted in Column `J,K,L,M,N` — HSHO, Aug 01 '22 at 19:35
Could you please clarify: in column J you want unique values of column A, in column K you want unique values of column B etc? — Ike, Aug 01 '22 at 19:38
Or use `=UNIQUE(A:A)` as Formula in `J2` - it will spill down automatically. — Ike, Aug 01 '22 at 19:49

urdearboy · Accepted Answer · 2022-08-02T15:32:56.147

It looks like your plan is to have a lr variable for each column as well as loops and transpose statements. You can avoid this by nesting your code in a column loop.

The current Column range is hard coded here (A to E) but this can be updated to be dynamic as needed. The output is also hard coded to be dropped 9 columns to the right of the input column. This aligns with A to J, B to K, etc.

Sub GetUniques()

Dim c As Variant, i As Long, lr As Long, col As Long
Dim d As Object

For col = 1 To 5     'Column A to E

    Set d = CreateObject("Scripting.Dictionary")
    
        lr = Cells(Rows.Count, col).End(xlUp).Row
        c = Range(Cells(2, col), Cells(lr, col))
    
        For i = 1 To UBound(c, 1)
            d(c(i, 1)) = 1
        Next i
    
        Cells(2, col + 9).Resize(d.Count) = Application.Transpose(d.keys)
    
    Set d = Nothing

Next col


End Sub

I actually was looking for this solution instead of repeating Unique function for each column Separalty. Thank you very much. — HSHO, Aug 01 '22 at 19:55
@urdearboy: I added the UNIQUE-solution as an alternative solution :-) — Ike, Aug 02 '22 at 06:42

score 1 · Answer 2 · answered Aug 02 '22 at 06:38

I am adding the UNIQUE- solution - for completeness:

You can either use a manual formula in J2: =UNIQUE(A:E,TRUE) - the second parameter tells UNIQUE to put out unique values per column --> it will spill from J to N.

You can use this formula in a VBA-routine as well:


Public Sub writeUniqueValues(rgSource As Range, rgTargetTopLeftCell As Range)

With rgTargetTopLeftCell
    .Formula2 = "=UNIQUE(" & rgSource.Address & ",TRUE)"
    With .SpillingToRange
       .Value = .Value 'this will replace the formula by values
    End With
End With

End Sub

You can then use this sub like this:

Public Sub test_writeUniqueValues()

With ActiveSheet 'be careful: you should always use explicit referencing
    Dim lr As Long
    lr = .Cells(Rows.Count, 1).End(xlUp).Row

    writeUniqueValues .Range("A2:E" & lr), .Range("J2")
End With

End Sub

It would be interesting to compare performance of both solutions (using the formula vs. using a dictionary) ...

Thank you very much indeed its a good appraoch. – HSHO Aug 02 '22 at 09:29 — HSHO, Aug 02 '22 at 09:29

Getting unique values for multiple column separatly

2 Answers2