Thread: [Solved] Removing duplicates
View Single Post
 
Old 05-25-2015, 05:05 PM
Bruno Campanini Bruno Campanini is offline Windows 8 Office 2013
Novice
 
Join Date: Nov 2014
Posts: 19
Bruno Campanini is on a distinguished road
Default

If you want to immediately delete duplicate (record or entire row):
=============================
Public Sub Test_1()
Dim k As Long, Split_1, Split_2
Dim h, i, j, n, SR As Range
Set SR = [Sheet1!A2:A29]
k = 1
For Each i In Range(SR(1), SR(SR.Count - 1))
k = k + 1
Split_1 = Split(i, " ")
For Each j In Range(i(k), SR(SR.Count))
Split_2 = Split(j, " ")
If UBound(Split_1) = UBound(Split_2) Then
k = 0
For Each h In Split_1
For Each n In Split_2
If h = n Then
k = k + 1
End If
Next
If k = UBound(Split_1) + 1 Then
'MsgBox i & " " & j & vbCrLf & _
i.Address & " " & j.Address
j(1, 1) = "*" & j.Address
End If
Next
End If
Next
k = 1
Next
For k = SR.Count To 1 Step -1
If Left(SR(k), 1) = "*" Then
' Delete Record
SR(k).Delete Shift:=xlUp

' Delete Entire Row
'SR(k).EntireRow.Delete Shift:=xlUp
End If
Next
End Sub
===============================

Bruno
Reply With Quote