Formula to extract unique records only

[hrayani]

Hi,

I need a formula to extract only the first occurrence of the data or unique records I can say. The formula should
look all the 3 columns in a row and should treat it as a duplicate if all the 3 cells are equal - otherwise not.

here is a sample data in A2:C17

Article	Quality	Unit
AA	1	Kgs
BB	2	Pair
DD	3	Dozen
EE	4	Grams
AA	1	Kgs
BB	2	Pair
AA	1	Kgs
AA	1	Kgs
DD	3	Dozen
AA	3	Pair
AA	5	Dozen
AA	5	Grams
AA	1	Kgs
AA	1	Kgs
AA	1	Kgs
AA	1	Kgs

<colgroup><col width="64" span="3" style="width:48pt"> </colgroup><tbody>
</tbody>

unique data required in columns H2:J17

in the above case the answer in H2:J17 would be

Article	Quality	Unit
AA	1	Kgs
BB	2	Pair
DD	3	Dozen
EE	4	Grams
AA	3	Pair
AA	5	Dozen
AA	5	Grams

<colgroup><col width="64" span="3" style="width:48pt"> </colgroup><tbody>
</tbody>

Rest all rows till 17 will show blanks as there is no more unique data.

If any one can provide a solution

Regards,

Humayun

 

[Kamolga]

The macro will do it automatically, no need to adap 17, 600 or any number later on.

[LEFT][COLOR=#222222][FONT=Verdana]Public Sub UniqueRow()
'LastRow
Dim lr As Long
lr = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]Range("A1:C" & lr).Copy
Range("h1").Select
ActiveSheet.Paste
Selection.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]End Sub[/FONT][/COLOR][/LEFT]

or if you want it done automatically when you come on sheet, right click sheet name, click view code and paste

Private Sub Worksheet_Activate()
'LastRow
Dim lr As Long
lr = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
Range("A1:C" & lr).Copy
Range("h1").Select
ActiveSheet.Paste
Selection.RemoveDuplicates Columns:=Array(1, 2, 3), _
        Header:=xlYes
End Sub

When you add data, simply leave the sheet and come back

 

[hrayani]

Hi James,

Thanks for the code

Hello,

You can test following:

Code:
Sub Unique3Cols()
With Worksheets("Sheet1")
.Range("A1:C17").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("H1:J1"), Unique:=True
End With
End Sub
HTH

What if the range A:C is not in a sequence.... i mean the columns are A,B & D... Is it possible ??

 

[hrayani]

Thanks Kamolga

 

[James006]

You can test :

Sub Unique3Cols()
    With Worksheets("Sheet1")
        .Range("H1:K1").Value = .Range("A1:D1").Value
        .Range("A1:D17").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("H1:K1"), Unique:=True
        .Columns("J:J").Delete Shift:=xlToLeft
    End With
End Sub

 

[hrayani]

Hi James,

Working Perfect..... Thanks

 

[James006]

Hi James,

Working Perfect..... Thanks

You are welcome ...