Forum

Delete duplicate da...
 
Notifications
Clear all

Delete duplicate data with keeping the new data

2 Posts
2 Users
0 Reactions
78 Views
(@debonly2014gmail-com)
Posts: 1
New Member
Topic starter
 

I had made an excel sheet with vb programming for delete duplicate
data with keeping the new data. But it delete the new data with keeping old.

Please If you kindly correct my code and solve my problem.

 

Here is the code below:

And the File is attached below

 

Sub TestForDups()

Dim LLoop As Integer
Dim LTestLoop As Integer

Dim Lrows As Integer
Dim LRange As String

Dim LCnt As Integer

'Column values
Dim LColA_1, LColB_1, LColC_1, LColD_1, LColE_1, LColF_1, LColG_1, LColH_1 As String
Dim LColA_2, LColB_2, LColC_2, LColD_2, LColE_2, LColF_2, LColG_2, LColH_2 As String

'Test first 2000 rows in spreadsheet for duplicates (delete any duplicates found)
Lrows = 200
LLoop = 2
LCnt = 0

'Check first 2000 rows in spreadsheet
While LLoop <= Lrows
'LColA_1 = "A" & CStr(LLoop)
LColB_1 = "B" & CStr(LLoop)
LColC_1 = "C" & CStr(LLoop)
'LColD_1 = "D" & CStr(LLoop)
'LColE_1 = "E" & CStr(LLoop)
'LColF_1 = "F" & CStr(LLoop)
'LColG_1 = "G" & CStr(LLoop)
'LColH_1 = "H" & CStr(LLoop)

If Len(Range(LColB_1).Value) > 0 Then

'Test each value for uniqueness
LTestLoop = LLoop + 1
While LTestLoop <= Lrows
If LLoop <> LTestLoop Then
'LColA_2 = "A" & CStr(LTestLoop)
LColB_2 = "B" & CStr(LTestLoop)
LColC_2 = "C" & CStr(LTestLoop)
'LColD_2 = "D" & CStr(LTestLoop)
'LColE_2 = "E" & CStr(LTestLoop)
'LColF_2 = "F" & CStr(LTestLoop)
'LColG_2 = "G" & CStr(LTestLoop)
'LColH_2 = "H" & CStr(LTestLoop)

'Value has been duplicated in another cell (based on values in columns A to H)

If (Range(LColB_1).Value = Range(LColB_2).Value) _
And (Range(LColC_1).Value = Range(LColC_2).Value) Then
'And (Range(LColD_1).Value = Range(LColD_2).Value) _
'And (Range(LColE_1).Value = Range(LColE_2).Value) _
'And (Range(LColF_1).Value = Range(LColF_2).Value) _
'And (Range(LColG_1).Value = Range(LColG_2).Value) _
'And (Range(LColH_1).Value = Range(LColH_2).Value)

'Delete the duplicate

Rows(CStr(LTestLoop) & ":" & CStr(LTestLoop)).Select
Selection.Delete Shift:=x1Up

'Decrement counter since row was deleted
LTestLoop = LTestLoop - 1

LCnt = LCnt + 1

End If

End If

LTestLoop = LTestLoop + 1
Wend

End If

LLoop = LLoop + 1
Wend

'Reposition back on cell A1
Range("B1").Select
MsgBox CStr(LCnt) & " rows have been deleted."

End Sub

 
Posted : 21/07/2018 2:37 am
(@sunnykow)
Posts: 1417
Noble Member
 

There is no duplicate data in your attachment. Highlight to us (if any) which are duplicates.

If you are using Excel 2010, you can use the Data - Remove Duplicates option.

Since your attachment is an xls file, I can only assume you are using Excel 2003 and before.

 
Posted : 21/07/2018 10:53 am
Share: