removing duplicates from a list

[Phill032]

Hi guys, there is a quite a few posts about this problem but havn't been able to get them to work how i need them to.. Hoping someone can help.
I have a vehicle stock list that has all the carlines in column C. I want to create a seperate list that only show the carline once. The idea is i will then rank them by most cars in stock and highest Grossing carline etc etc.
Any help would be appreciated

 

[davidam]

For this type of thing I have always created a VBA Find loop. You put the two columns side by side, say columns A and B. Then you start with the first cell in column A. Search for the Value of each cell in column A in the dynamic range that runs from the cell in next row of column B to the bottom of Column B. If found it puts a "1" in column C. All duplicates will be marked with a "1" in column C. Then sort all of the columns by column C. You have to use "On Error Resume Next" so that it will continue if it does not find a duplicate.

 

[Rick Rothstein]

Here is a macro that you can try...

[table="width: 500"]
[tr]
	[td]Sub Uniques()
  Dim R As Long, X As Long, Data As Variant, CellData() As String
  Data = Range("C[B][COLOR="#FF0000"][SIZE=4]1[/SIZE][/COLOR][/B]", Cells(Rows.Count, "C").End(xlUp))
  With CreateObject("Scripting.Dictionary")
    For R = 1 To UBound(Data)
      If Len(Data(R, 1)) Then
        .RemoveAll
        CellData = Split(Trim(Data(R, 1)), ",")
        For X = 0 To UBound(CellData)
          .Item(CellData(X)) = 1
        Next
        Data(R, 1) = Join(.Keys, ",")
      End If
    Next
  End With
  Range("[B][COLOR="#FF0000"][SIZE=4]F1[/SIZE][/COLOR][/B]").Resize(UBound(Data)) = Data
End Sub[/td]
[/tr]
[/table]

You did not say if your data has headers or not, so I assumed they did not. If you do have headers, change the red highlighted number 1 at the beginning to the row number for your first data item. Also, you did not say where to put the list, so I assumed Column F (change the red highlighted "F1" to the cell address where you want the list to start at.

 

[MickG]

Try this :-

"Carlines" in column "C" starting "C2".
Results start "F1" with Carlines sorted by "Carline" count, with count n column "G".

[COLOR=navy]Sub[/COLOR] MG31Jul35
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] K [COLOR=navy]As[/COLOR] Variant, oMax [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] nStr [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range("C2", Range("C" & Rows.Count).End(xlUp))
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    .Item(Dn.Value) = .Item(Dn.Value) + 1
[COLOR=navy]Next[/COLOR]

ReDim ray(1 To .Count + 1, 1 To 2)
c = 1
ray(1, 1) = "Carlines": ray(1, 2) = " Line Count"
[COLOR=navy]
For[/COLOR] n = 1 To .Count
  oMax = Application.Large(.Items, n)
  
 [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .KEYS
      [COLOR=navy]If[/COLOR] .Item(K) = oMax [COLOR=navy]Then[/COLOR]
            [COLOR=navy]If[/COLOR] InStr(nStr, K) = 0 [COLOR=navy]Then[/COLOR]
                nStr = nStr & K
                c = c + 1
                ray(c, 1) = K
                 ray(c, 2) = .Item(K) '[COLOR=green][B]remove this line if you Don't want the count[/B][/COLOR]
            [COLOR=navy]End[/COLOR] If
        [COLOR=navy]End[/COLOR] If
[COLOR=navy]  Next[/COLOR] K
[COLOR=navy]Next[/COLOR] n
[COLOR=navy]End[/COLOR] With
Range("F1").Resize(c, 2).Value = ray
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick