Need help with deleting duplicates

[SoftPaper]

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]

[vba]


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
[/vba]

[SoftPaper]

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]

Do you want to delete the whole row?

[SoftPaper]

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]

I maen if there is data in coliumn C, D and so on, does that get deleted as ell?

[SoftPaper]

Oh.. no worries. I only have 2 columns. A and B only. ^^

[SoftPaper]

I hope i phrase it correctly. Column A with 50000 Rows(down) and Column B with 50000 Rows(down)

[rajkumar]

Hi,
Check this out whether it is suiting you.

[VBA]
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
[/VBA]

Raj

[Bob Phillips]

[vba]

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
[/vba]

[SoftPaper]

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]

Select your columns A and B and run the macro

Raj

[SoftPaper]

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]

Do you want to post an example, I think I get it, but I want to be sure.

[Aussiebear]

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....