delete non duplicate data in excel using VBA - vba

Question

i try to remove non-duplicate data and keep the duplicate data
i've done some coding, but nothing happen, oh. it's error. lol
this is my code.
Sub mukjizat2()
Dim desc As String
Dim sapnbr As Variant
Dim shortDesc As String
X = 1
i = 2
desc = Worksheets("process").Cells(i, 3).Value
sapnbr = Worksheets("process").Cells(i, 1).Value
shortDesc = Worksheets("process").Cells(i, 2).Value
Do While Worksheets("process").Cells(i, 1).Value <> ""
If desc = Worksheets("process").Cells(i + 1, 3).Value <> Worksheets("process").Cells(i, 3) Or Worksheets("process").Cells(i + 1, 2) <> Worksheets("process").Cells(i, 2) Then
Delete.EntireRow
Else
Worksheets("output").celss(i + 1, 3).Value = desc
Worksheets("output").Cells(i + 1, 1).Value = sapnbr
Worksheets("output").Cells(i + 1, 2).Value = shortDesc
X = X + 1
End If
i = i + 1
Loop
End Sub
what have i done wrong?
what i expect :
before :
sapnbr | ShortDesc | Desc
11 | black hat | black cowboy hat vintage
12 | sunglasses| black sunglasses
13 | Cowboy hat| black cowboy hat vintage
14 | helmet 46 | legendary helmet
15 | v mask | vandeta mask
16 | helmet 46 | valentino rossi' helmet replica
after
sapnbr | ShortDesc | Desc
11 | black hat | black cowboy hat vintage
13 | Cowboy hat| black cowboy hat vintage
14 | helmet 46 | legendary helmet
16 | helmet 46 | valentino rossi' helmet replica
UPDATE, using coding by #siddhart, the unique value deleted, but not all,
http://melegenda.tumblr.com/image/70456675803

Answer 1

Like I mentioned in my comment above, the main flaw in the code logic is that it will fail if the data is not sorted. You need to approach the problem with a different logic
Logic:
Use Countif to check of the value occurs more than once.
Store the row number in a temp range in case more than one match is found
Delete the temp range at the end of the code. We could have deleted each row in a loop but then that will slow down your code.
Code:
Option Explicit
Sub mukjizat2()
Dim ws As Worksheet
Dim i As Long, lRow As Long
Dim delRange As Range
'~~> This is your sheet
Set ws = ThisWorkbook.Sheets("process")
With ws
'~~> Get the last row which has data in Col A
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Loop through the rows
For i = 2 To lRow
'~~> For for multiple occurances
If .Cells(i, 2).Value <> "" And .Cells(i, 3).Value <> "" Then
If Application.WorksheetFunction.CountIf(.Columns(2), .Cells(i, 2)) = 1 And _
Application.WorksheetFunction.CountIf(.Columns(3), .Cells(i, 3)) = 1 Then
'~~> Store thee row in a temp range
If delRange Is Nothing Then
Set delRange = .Rows(i)
Else
Set delRange = Union(delRange, .Rows(i))
End If
End If
End If
Next
End With
'~~> Delete the range
If Not delRange Is Nothing Then delRange.Delete
End Sub
ScreenShot:

Answer 2

I know the problem now, hehe.
The code that sid gave me also detect the duplication inter-column
So, my solution is, I just cut the duplicates and paste it to other sheet
Sub hallelujah()
Dim duplicate(), i As Long
Dim delrange As Range, cell As Long
Dim delrange2 As Range
x = 2
Set delrange = Range("b1:b30000")
Set delrange2 = Range("c1:c30000")
For cell = 1 To delrange.Cells.Count
If Application.CountIf(delrange, delrange(cell)) > 1 Then
ReDim Preserve duplicate(i)
duplicate(i) = delrange(cell).Address
i = i + 1
End If
Next
For cell = 1 To delrange2.Cells.Count
If Application.CountIf(delrange2, delrange2(cell)) > 1 Then
ReDim Preserve duplicate(i)
duplicate(i) = delrange(cell).Address
i = i + 1
End If
Next
For i = UBound(duplicate) To LBound(duplicate) Step -1
Range(duplicate(i)).EntireRow.Cut
Sheets("output").Select
Cells(x, 1).Select
ActiveSheet.Paste
Sheets("process").Select
x = x + 1
Next i
end sub
I took someone's answer in another question and modify it a bit, just need to modify little bit more to detect duplication base on similarity
Thanks all!