removing duplicates from a list

Phill032

New Member
Joined
Nov 9, 2016
Messages
38
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
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

davidam

Active Member
Joined
May 28, 2010
Messages
452
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.
 
Last edited:

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
37,557
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
Here is a macro that you can try...
Code:
[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

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this :-

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

Code:
[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
 
Last edited:

Forum statistics

Threads
1,148,294
Messages
5,745,944
Members
423,985
Latest member
sayed manzar

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top