PDA

View Full Version : Solved: Delete duplicates



av8tordude
06-08-2011, 06:52 PM
I need a code that will find any duplicates cities in column B and delete the city and the entire row of that duplicate city that is to be deleted, leaving only one set

Example:

Alabama | Gulf Shores | Baldwin | ...
Alabama | Gulf Shores | Baldwin | ...
Arizona | Grand Canyon | Coconino| ...
Arizona | Grand Canyon | Coconino| ...
Arizona | Grand Canyon | Coconino| ...

Results:

Alabama | Gulf Shores | Baldwin | ...
Arizona | Grand Canyon | Coconino| ...

av8tordude
06-08-2011, 07:13 PM
I found a resolution to my problem.

http://www.vbaexpress.com/kb/getarticle.php?kb_id=135

GTO
06-08-2011, 07:15 PM
Hi Aviator,

I note that there is differing info the the columns past C. Do we care which record is retained?

Mark

av8tordude
06-08-2011, 07:30 PM
Hi GTO,

No, I was only concerned about deleting the duplicates. Thank you for checking.

On another note, could you help with a code that will lookup the County in column V and insert the County into column S for the City & State (Column Q & R)

av8tordude
06-08-2011, 08:26 PM
anyone?

Also, is it possible to look at column B & C (City & County) to find duplicates and then delete the row? What I discovered, some Cities listed have similar County names.

Example

Durham, Durham
&
Durham, Strafford

I've tried the code below, but it definitely did not like that.

Sub DeleteDups()
Dim x As Long, LastRow As Long

LastRow = Cells(Rows.Count, 1).End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("B1:C" & x), Range("B:C" & x).Text) > 1 Then
Range("B:C" & x).EntireRow.Delete
End If
Next x
End Sub

mancubus
06-09-2011, 08:51 AM
i use below procedure to delete duplicates based on multiple columns.
(in this example cols A, B and C)



Sub DelDupRows()

Dim LR As Long, rww As Long
Dim dic As Object
Dim ws As Worksheet

Application.ScreenUpdating = False

Set dic = CreateObject("Scripting.Dictionary")
Set ws = ActiveSheet
LR = ws.Range("A" & Rows.Count).End(xlUp).Row

rww = 2
While rww <= LR
If dic.exists(ws.Range("A" & rww).Value & ws.Range("B" & rww).Value _
& ws.Range("C" & rww).Value) Then
ws.Rows(rww).Delete shift:=xlUp
LR = LR - 1
Else
dic.Add ws.Range("A" & rww).Value & ws.Range("B" & rww).Value _
& ws.Range("C" & rww).Value, 1
rww = rww + 1
End If
Wend

Application.ScreenUpdating = True

End Sub