Macro to extract Unique Account Numbers

[howard]

I have account Numbers in Col A and in Col C. I need to compare these and extract into Col G , those that are unique to both Columns


I have tried to write code to compare the account numbers in Col A & C and extract those that are unique to both in Col G, but the code only copies the exact data that appears in Col A & C and not those that are unique to both these columns

When the unique records are extracted in Col G, I would also like the Col Number where the record was extracted to display in Col H

It would be appreciated if someone could kindly amend my code

 Sub Extract_Unique_ITEMS()
Sheets(14).Select

Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).AdvancedFilter _
    Action:=xlFilterCopy, CopyToRange:=Range("G2"), Unique:=True
End Sub

See Sample Data of what the unique records should look like once extracted

Excel 2012
	A	B	C	D	E	F	G	H
1	Mapping Data		Input Data
2	KNR-3004		KNR-3024				KNR-3004	Col A
3	KNR-3024		KNR-3025				KNR-3026	Col A
4	KNR-3025		KNR-3064				KNR-3027	Col A
5	KNR-3026		KNR-3065				KNR-3029	Col A
6	KNR-3027		KNR-3066				KNR-3067	Col A
7	KNR-3029		KNR-3304				KNR-3304	Col B
8	KNR-3064		KNR-3305				KNR-3305	Col B
9	KNR-3065		KNR-3306				KNR-3306	Col B
10	KNR-3066		KNR-3514				KNR-3514	Col B
11	KNR-3067		KNR-3524				KNR-3524	Col B
12
13
14
15
Sheet1

 

[Vidya Palani]

See if this works..

Sub Extract_Unique_ITEMS()Dim rng As Range
Dim rng2 As Range
Dim lastrow As Long
Dim counter As Long
Dim thiscell As Range
    Sheets(14).Select
    With ActiveSheet
        lastrow = ActiveSheet.Cells(1048576, 1).End(xlUp).Row
    End With
    Set thiscell = Range("G2")
    counter = 0
    For Each rng In Range(Range("A2"), Range("A" & lastrow))
        For Each rng2 In Range(Range("C2"), Range("C" & lastrow))
            If rng.Value <> rng2.Value Then
                counter = counter + 1
            Else
                Exit For
            End If
        Next
        If counter = lastrow - 1 Then
            thiscell.Value = rng.Value
            thiscell.Offset(0, 1).Value = "Col A"
            Set thiscell = thiscell.Offset(1, 0)
        End If
        counter = 0
    Next
    For Each rng In Range(Range("C2"), Range("C" & lastrow))
        For Each rng2 In Range(Range("A2"), Range("A" & lastrow))
            If rng.Value <> rng2.Value Then
                counter = counter + 1
            Else
                Exit For
            End If
        Next
        If counter = lastrow - 1 Then
            thiscell.Value = rng.Value
            thiscell.Offset(0, 1).Value = "Col C"
            Set thiscell = thiscell.Offset(1, 0)
        End If
        counter = 0
    Next
End Sub

 

[howard]

Thanks for the help, much appreciated

 

[Rick Rothstein]

Here is a more compact macro (which I believe is faster) that I think will also work (assuming where you wrote Col B that you meant Col C)...

[table="width: 500"]
[tr]
	[td]Sub GetUniques()
  Dim X As Long, A As String, C As String, AA As Variant, CC As Variant, Uniq As Variant
  Sheets(14).Select
  AA = Application.Transpose(Range("A2", Cells(Rows.Count, "A").End(xlUp)))
  CC = Application.Transpose(Range("C2", Cells(Rows.Count, "C").End(xlUp)))
  A = " " & Join(AA) & " "
  C = " " & Join(CC) & " "
  For X = 1 To UBound(AA)
    C = Replace(C, " " & AA(X) & " ", "  ")
  Next
  C = Replace(Application.Trim(C), " ", "|Col_C ") & "|Col_C"
  For X = 1 To UBound(CC)
    A = Replace(A, " " & CC(X) & " ", "  ")
  Next
  A = Replace(Application.Trim(A), " ", "|Col_A ") & "|Col_A"
  Uniq = Split(Application.Trim(A & " " & C))
  Columns("G:H").ClearContents
  Range("G2").Resize(UBound(Uniq) + 1) = Application.Transpose(Uniq)
  Columns("G").TextToColumns Range("G1"), xlDelimited, , , 0, 0, 0, 0, 1, "|"
  Columns("H").Replace "_", " ", xlPart
End Sub[/td]
[/tr]
[/table]

 

[howard]

Thanks Rick, this is perfect


I have another scenario where I want to compare account numbers in Col A with Col C and extract the account numbers in Col A that do not appear in Col C in Col J

It would be appreciated if you could kindly assist me

 

[Ombir]

I have account Numbers in Col A and in Col C. I need to compare these and extract into Col G , those that are unique to both Columns


I have tried to write code to compare the account numbers in Col A & C and extract those that are unique to both in Col G, but the code only copies the exact data that appears in Col A & C and not those that are unique to both these columns

When the unique records are extracted in Col G, I would also like the Col Number where the record was extracted to display in Col H

It would be appreciated if someone could kindly amend my code

 Sub Extract_Unique_ITEMS()
Sheets(14).Select

Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).AdvancedFilter _
    Action:=xlFilterCopy, CopyToRange:=Range("G2"), Unique:=True
End Sub

See Sample Data of what the unique records should look like once extracted

Excel 2012

	A	B	C	D	E	F	G	H
1	Mapping Data		Input Data
2	KNR-3004		KNR-3024				KNR-3004	Col A
3	KNR-3024		KNR-3025				KNR-3026	Col A
4	KNR-3025		KNR-3064				KNR-3027	Col A
5	KNR-3026		KNR-3065				KNR-3029	Col A
6	KNR-3027		KNR-3066				KNR-3067	Col A
7	KNR-3029		KNR-3304				KNR-3304	Col B
8	KNR-3064		KNR-3305				KNR-3305	Col B
9	KNR-3065		KNR-3306				KNR-3306	Col B
10	KNR-3066		KNR-3514				KNR-3514	Col B
11	KNR-3067		KNR-3524				KNR-3524	Col B
12
13
14
15

<tbody>
</tbody>

Sheet1​

Hi Howard,

Here is more Compact and faster approach:

Sub howard()
Dim rng     As Range
Dim dict    As Object

Set dict = CreateObject("scripting.dictionary")
Set rng = Range("A2:C" & Cells(Rows.Count, 1).End(xlUp).Row)

With dict
For Each cell In rng
    If Application.CountIf(rng, cell) = 1 Then
        .Item(cell.Value2) = "Col " & Split(Cells(1, cell.Column).Address, "$")(1)
    End If
Next
Range("I2").Resize(.Count) = Application.Transpose(.keys)
Range("J2").Resize(.Count) = Application.Transpose(.items)
End With
End Sub

 

[howard]

Thanks very much

 

[Ombir]

Thanks very much

Hi Howard,

Check Edited Post. Its more compact and faster than I posted previously.

 

[howard]

Thanks for the code, it is lightening fast

 

[Ombir]

Thanks Rick, this is perfect


I have another scenario where I want to compare account numbers in Col A with Col C and extract the account numbers in Col A that do not appear in Col C in Col J

It would be appreciated if you could kindly assist me

Try this:

Sub howard()
Dim ele         As Variant
Dim ar          As Variant
Dim dict        As Object

Set dict = CreateObject("scripting.dictionary")
ar = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)

With dict
For Each ele In ar
    If Application.CountIf(Range("C2:C" & Cells(Rows.Count, 1).End(xlUp).Row), ele) = 0 Then
        .Item(ele) = Empty
    End If
Next
Range("J2").Resize(.Count) = Application.Transpose(.keys)
End With
End Sub