Autofilter/Delete Duplicates/Find Changes

[gemsera]

Hi All,

I have managed to get a little bit further in my project, and now I am hoping to output the changes to the file into an email to advise the staff of the progress.

Basically I have two lists, both of which are almost identical. Certain columns in these can change (i.e comments, Status etc) and I need sort the list to include only items (sort by number) which have changed. I will manually check the list before sending (to ensure excel has the right change).

So columns:


Number - Title - Comment - Priority - Status
1 XYZ Prob "SSSSSS" A Closed
1 XYZ Prob "SSSSSS" A Open

There will be two of each, if they are identical (in each cell), delete both, if they are different choose the second one.

Hope this explains OK, really hope there is a way to do this :)

[Bob Phillips]

Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet

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

If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then

If .Cells(i, "C").Value = .Cells(i - 1, "C").Value And _
.Cells(i, "E").Value = .Cells(i - 1, "E").Value And _
.Cells(i, "G").Value = .Cells(i - 1, "G").Value And _
.Cells(i, "I").Value = .Cells(i - 1, "I").Value Then

.Rows(i - 1).Resize(2).Delete
Else

.Rows(i - 1).Delete
i = i - 1
End If
End If
Next i
End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

[gemsera]

Hey XLD, thank you for such a prompt response. Would you or anyone else be able to provide a small explanation for the code? I'm not quite experienced enough to be able to understand it as yet :)

Again, much appreciated.

[Bob Phillips]

It simply goes thorugh each line bottom to top, and if the key column (Column A) of this and the previous row are the same it then checks columns C, E, G and I and if ALL of these are the same, it deletes both rows, else it just deletes the previous.

[gemsera]

Thank you again xld. Quite ingenius. I have a column which has last modified date and time, would there be a way to check which was the last modified before deleting the duplicate?

So if they are identical, delete both. If they differ, delete the oldest record.

And is there any way I can support the community here? You guys have saved my mind from being lost in VBA.

[Bob Phillips]

Sure, what column is the modified date ciolumn?

[gemsera]

Lets say P? I can modify the code OK once I understand it, just useless at writing it!

[Bob Phillips]

I am assuming all the other checks are redundant, we just check the id and teh date now



Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet

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

If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then

If .Cells(i, "P").Value = .Cells(i - 1, "P").Value Then

.Rows(i - 1).Resize(2).Delete
ElseIf .Cells(i, "P").Value > .Cells(i - 1, "P").Value Then

.Rows(i - 1).Delete
i = i - 1
Else

.Rows(i).Delete
End If
End If
Next i
End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

[gemsera]

Hiya Xld,
The original code worked to a degree, there were still some discrepancies(only 2, which may be unrelated). This second lot of code doesnt appear to be removing the originals (i.e I still have 300 or so rows where I ought to have 20ish).

Here is what I have:


Sub ProcessData()
Dim i As Long
Dim LastRow As Long


'Autofilter to ensure the numbers are in order.
Range("B5:O500").Select
Selection.AutoFilter
Range("B5:O500").Sort Key1:=Range("B5"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet

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

If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then

If .Cells(i, "M").Value = .Cells(i - 1, "M").Value Then

.Rows(i - 1).Resize(2).Delete
ElseIf .Cells(i, "M").Value > .Cells(i - 1, "M").Value Then

.Rows(i - 1).Delete
i = i - 1
Else

.Rows(i).Delete
End If
End If
Next i
End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With



'Remove unwanted columns
Columns("D:D").Select
Selection.Delete
Columns("E:E").Select
Selection.Delete
Columns("G:M").Select
Selection.Delete

'Insert required space for email
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Rows("4:4").Select
Selection.Insert Shift:=xlDown
Rows("6:6").Select
Selection.Insert Shift:=xlDown

End Sub



The format for the modified date/time is:
YYYY/MM/DD HH:MM:SS

Would it work better if it was formatted to display DD/MM/YYY?

[Bob Phillips]

Nope, a date is a date is a date. Did you read my preliminary comment in my last post?

[gemsera]

Terribly sorry, blind as a bat. Yes I did, and you of course thought of it when I wasn't even going to.

I was using A instead of column B (where the number is). This has fixed it to a point, but I still had 100 or so changes. This could have been my fault - dealing in old data.

I have tested it and it has now worked. thank you very very much for your help and patience!

[Cleaner007]

As for duplicates i solve all problems with Clone Remover. Nice app:thumb!
moleskinsoft.com

[gemsera]

Hey thanks mate, I'll check it out :)

[N35t0r]

Hello all, I'm new and bumping this thread because it's pretty close to what I'm looking for and I felt it didn't warrant a new thread.

I have a similar problem, but only need to delete duplicate entries after sorting. I have added a command button macro to do the sorting, and can attach the code there.

I have no experience with VBA, but do know some, C and assembler, but I think I can read some of the code.

If I am not mistaken the following modification to XLD's code will work for me:



Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 8 Step -1 'My table starts at 8

If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then

If .Cells(i, "G").Value = .Cells(i - 1, "P").Value Then

.Rows(i).Delete

End If
End If
Next i
End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

Thanks :b:


[edit:]

Yes it does, apparently :)