Getting unique values for multiple column separatly-CodePudding

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

CodePudding user response：

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

It's worth noting that anyone on newer versions of excel may have access to the new UNIQUE function should consider that as first option since it can be done right on the worksheet.