Getting unique values for multiple column separatly - excel

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

Answer 1

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

Answer 2

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) ...