PDA

View Full Version : Need help with deleting duplicates



SoftPaper
09-24-2008, 05:58 AM
Hi guys, I have this macro provided to me by royUK. I've modified this code abit in such a way that it will check for all duplicated values in Column B and display the word "Duplicated" in the corresponding Cloumn C.



Sub check_Duplicate() Dim rLook As Range Dim rFind As Range Dim sAdr As String Sheets("CALCULAT").Activate lRow = Cells(Rows.Count, "B").End(xlUp).Row For iRow = 1 To Cells(Rows.Count, "B").End(xlUp).Row - 1 With Cells(iRow, "B") If .Value <> "S" Then Set rLook = Range(.Offset(1), Cells(lRow, "B")) Set rFind = rLook.Find(What:=.Value, _ LookIn:=xlValues, LookAt:=xlWhole, _ MatchCase:=False, MatchByte:=False, _ After:=Cells(lRow, "B")) If Not rFind Is Nothing Then sAdr = rFind.Address Do If rFind.Offset(, 1).Value = .Offset(, 1).Value Then .Offset(, 1).Value = "Duplicated" rFind.Offset(, 1).Value = "Duplicated" End If Set rFind = rLook.FindNext(rFind) Loop While rFind.Address <> sAdr End If End If End With Next iRowEnd Sub

But now i need to modify the code again so that it will delete duplicated values in Column B instead. I'm not sure how. Tried afew ways but didn't work out. Any help here would be greatly appreciated.

Thanks guys.

Bob Phillips
09-24-2008, 06:15 AM
Sub check_Duplicate()
Dim lRow As Long
Dim iRow As Long

With Sheets("CALCULAT")

lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For iRow = lRow To 2 Step -1

If .Cells(iRow, "B").Value <> "S" Then

If Application.CountIf(.Range("B1").Resize(iRow), .Cells(iRow, "B").Value) > 1 Then

.Cells(iRow, "B").Delete shift:=xlShiftUp
End If
End If
Next iRow
End With
End Sub

SoftPaper
09-24-2008, 06:34 AM
Hey XLD,
I'm sorry. I think i kinda said the wrong thing. So i'll begin afresh.
I have 2 columns A and B each with thousand over cells. So i want to compare these 2 columns with each other and delete duplicates found from Both sides leaving only unique values. Really sorry...

Bob Phillips
09-24-2008, 06:49 AM
Do you want to delete the whole row?

SoftPaper
09-24-2008, 06:59 AM
Erm.. Not sure what you mean. OK for example

ColumnA ColumnB
1 5
2 4
3 1

for example if 1 is duplicated in both Column A and B. Then both 1 from A and B should be deleted off. But the thing is I have like 60 000 values in both Column A and Column B.

Bob Phillips
09-24-2008, 07:02 AM
I maen if there is data in coliumn C, D and so on, does that get deleted as ell?

SoftPaper
09-24-2008, 07:05 AM
Oh.. no worries. I only have 2 columns. A and B only. ^^

SoftPaper
09-24-2008, 07:36 AM
I hope i phrase it correctly. Column A with 50000 Rows(down) and Column B with 50000 Rows(down)

rajkumar
09-24-2008, 07:50 AM
Hi,
Check this out whether it is suiting you.


Sub KillDupes()
Dim rConstRange As Range, rFormRange As Range
Dim rAllRange As Range, rCell As Range
Dim iCount As Long
Dim strAdd As String
On Error Resume Next
Set rAllRange = Selection
If WorksheetFunction.CountA(rAllRange) < 2 Then
MsgBox "You selection is not valid", vbInformation
On Error GoTo 0
Exit Sub
End If
Set rConstRange = rAllRange.SpecialCells(xlCellTypeConstants)
Set rFormRange = rAllRange.SpecialCells(xlCellTypeFormulas)
If Not rConstRange Is Nothing And Not rFormRange Is Nothing Then
Set rAllRange = Union(rConstRange, rFormRange)
ElseIf Not rConstRange Is Nothing Then
Set rAllRange = rConstRange
ElseIf Not rFormRange Is Nothing Then
Set rAllRange = rFormRange
Else
MsgBox "You selection is not valid", vbInformation
On Error GoTo 0
Exit Sub
End If
Application.Calculation = xlCalculationManual
For Each rCell In rAllRange
strAdd = rCell.Address
strAdd = rAllRange.Find(What:=rCell, After:=rCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Address
If strAdd <> rCell.Address Then
rCell.Clear
End If
Next rCell
Application.Calculation = xlCalculationAutomatic
On Error GoTo 0
End Sub


Raj :whistle:

Bob Phillips
09-24-2008, 08:04 AM
Sub check_Duplicate()
Dim lRow As Long
Dim iRow As Long

With Sheets("CALCULAT")

lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For iRow = lRow To 2 Step -1

If .Cells(iRow, "A").Value = .Cells(iRow, "B").Value Then

.Rows(iRow).Delete
End If
Next iRow
End With
End Sub

SoftPaper
09-24-2008, 08:09 AM
Hey rajKumar, really thanks for the help but when i ran the macros it said Invalid Selection. I'm not sure what am i suppose to do. Am i suppose to select a cell first then run the macros??

XLD, Honestly Thanks alot man. Your macros works perfectly...

rajkumar
09-24-2008, 08:19 AM
Select your columns A and B and run the macro

Raj :whistle:

SoftPaper
09-24-2008, 08:56 AM
Ok, Ya it works great as well. Thanks alot rajKumar.

And XLD. Regarding the macro you provided for me that's 1 problem.


If .Cells(iRow, "A").Value = .Cells(iRow, "B").Value

The problem is the the duplicated values are not side by side. Could you help me with this?

Bob Phillips
09-24-2008, 10:33 AM
Do you want to post an example, I think I get it, but I want to be sure.

Aussiebear
09-28-2008, 02:50 AM
Bob, my reading of the request by the OP is that if a value within Column A is found in Column B then only the matching values are deleted rather than the row....