PDA

View Full Version : Extracting Unique Rows based on multiple colunms



rehan.azher
12-02-2008, 02:48 AM
Dear Experts,

I am facing a problem to extract unique rows from the a sheet. My sheet have four columns as below.

EQX-A 08 SLD64 01
SGP-B 08 SLD64 01
SGP-B 08 SLD64 01
JKT-B 07 SL64 01
EQX-A 08 SLD64 02

now i want to get unique rows from the above as below

EQX-A 08 SLD64 01 SGP-B 08 SLD64 01 JKT-B 07 SL64 01 EQX-A 08 SLD64 02
Note: first and lost row have fourth column different. and 2nd , 3rd are completely identical to each other.


i want to copy the result to another sheet.

any help for this in VBA

Krishna Kumar
12-02-2008, 04:14 AM
Hi,

try,

Sub kTest()
Dim a, i As Long, w(), n As Long, s, c As Long
a = Range("a1").CurrentRegion.Resize(, 4)
ReDim w(1 To UBound(a, 1), 1 To 4)
With CreateObject("scripting.dictionary")
.comparemode = vbTextCompare
For i = 1 To UBound(a, 1)
For c = 1 To UBound(a, 2)
s = s & ";" & a(i, c)
Next
s = Mid$(s, 2)
If Not .exists(s) Then
n = n + 1
For c = 1 To UBound(a, 2)
w(n, c) = a(i, c)
Next
.Add s, Nothing
End If
s = ""
Next
End With
With Sheets("Sheet2").Range("a1")
.Resize(n, 4).Value = w
End With
End Sub

HTH

rehan.azher
12-02-2008, 06:29 AM
Dear,

I do not have any expertise with VBA, my first column is G and my first row would be 6 , i.e. my columns are G , H, I, J and for rows i want to iterate till last row used in my sheet.

I tried to modify it but am not successful, can your function be modified accordingly.

Krishna Kumar
12-02-2008, 08:13 AM
Hi,

change

a = Range("a1").CurrentRegion.Resize(, 4)

to

a = Range("g6:j" & Range("g" & Rows.Count).End(xlUp).Row)

HTH