Remove duplicates, return multiple columns

[tiredofit]

This code will remove duplicates from column A, so if my data was:

a
a
b
c
d

it will return:

a
b
c
d

Here is the code:

    Dim DIC As Object
    Set DIC = CreateObject("Scripting.Dictionary")

    
    Dim MyArray() As Variant

    MyArray() = Sheet1.Cells(1, 1).CurrentRegion.Value

    
    Dim n As Long


    For n = 1 To UBound(MyArray(), 1)

        DIC.Item(MyArray(n, 1)) = 0

    Next n


    MyArray() = DIC.Keys


    Dim NewArray() As Variant
    ReDim NewArray(1 To DIC.Count - 1) As Variant


    Dim a As Long


    For a = 1 To DIC.Count - 1

        NewArray(a) = MyArray(a)

    Next a

But how can I adapt it so that if my data contains 2 columns, that it looks for duplicates in column A and then returns BOTH columns of data, eg

a 1
a 2
b 3
c 4
d 5

and I want it to return:

a 1
b 3
c 4
d 5

Thanks

 

[Fluff]

Maybe

Sub tiredofit()
   Dim Dic As Object
   Dim Ary As Variant
   Dim i As Long
   
   Ary = Sheet2.Range("A1").CurrentRegion.Value2
   Set Dic = CreateObject("scripting.dictionary")
   For i = 1 To UBound(Ary)
      Dic.Item(Ary(i, 1)) = Ary(i, 2)
   Next i
   ReDim Nary(1 To Dic.Count, 1 To 2)
   For i = 0 To Dic.Count - 1
      Nary(i + 1, 1) = Dic.Keys()(i)
      Nary(i + 1, 2) = Dic.Items()(i)
   Next i
   
End Sub

 

[tiredofit]

Maybe

Sub tiredofit()
   Dim Dic As Object
   Dim Ary As Variant
   Dim i As Long
   
   Ary = Sheet2.Range("A1").CurrentRegion.Value2
   Set Dic = CreateObject("scripting.dictionary")
   For i = 1 To UBound(Ary)
      Dic.Item(Ary(i, 1)) = Ary(i, 2)
   Next i
   ReDim Nary(1 To Dic.Count, 1 To 2)
   For i = 0 To Dic.Count - 1
      Nary(i + 1, 1) = Dic.Keys()(i)
      Nary(i + 1, 2) = Dic.Items()(i)
   Next i
   
End Sub

Thanks

I did it like this:

    Dim DIC As Object
    Set DIC = CreateObject("Scripting.Dictionary")

    
    Dim MyArray() As Variant

    MyArray() = Sheet1.Cells(1, 1).CurrentRegion.Value
    
    Dim MyArrayRows As Integer
    
    MyArrayRows = UBound(MyArray(), 1)
    
    Dim MyArrayCols As Integer
    
    MyArrayCols = UBound(MyArray(), 2)
    
    Dim UniqueArray() As Variant
    ReDim UniqueArray(1 To MyArrayRows, 1 To MyArrayCols) As Variant
    
    Dim n As Long
    
    Dim i, j
    
    i = 1
    
    On Error GoTo ErrHandle
    
    For n = 1 To UBound(MyArray(), 1)
        
        DIC.Add MyArray(n, 1), MyArray(n, 1)
            
        For j = 1 To MyArrayCols
        
            UniqueArray(i, j) = MyArray(n, j)
            
            
        Next j
        
        i = i + 1
        
Cont:


    Next n
        
    Exit Sub
    
    
Errhandle:
    
    Resume Cont

so when there's a duplicate, I handle the error, else I loop through another array.

 

[Fluff]

Personally I'd get rid of the error handler & do it like

   For n = 1 To UBound(MyArray(), 1)
      If Not Dic.Exists(MyArray(n, 1)) Then
         Dic.Add MyArray(n, 1), MyArray(n, 1)
         For j = 1 To MyArrayCols
            UniqueArray(i, j) = MyArray(n, j)
         Next j
         i = i + 1
      End If
   Next n

 

[tiredofit]

Good suggestion, thanks.

 

[Fluff]

You're welcome