VBA code to delete duplicate rows based off data from other columns

[loddydoddy81]

Hi. First post here, trying to do my best to search for answers/use codes that are already what I need or nearly what I need and modify to work. Can't really find any other threads that meet the criteria for my issue.
I have a report I run weekly which has training for coworkers. After the data is copy/pasted in my product it's sorted/filtered and also it deletes rows with certain training courses not needed and/or names of coworkers who are not needed to be tracked. It ends up with 5 columns, A-E. Like this:
Column A Column B Col C Column D Column E

What I need is after it does all that, I need it to further remove duplicate rows. For example the row for Mr. Fury with date of 4/27/2021 and Mr. Parker dated 3/23/2021 need to be deleted and either row for Mr. Stark to be deleted. I don't have code in there to sort the Date completed column to ascending/descending, so that might have to be added in, from what i've been reading/researching.

I feel like this is a pretty simple thing, someone has probably asked before, but I have been unable to find a thread with this request (probably not searching correct terms or something). I appreciate any help!

 

[Trebor76]

Hi loddydoddy81,

Welcome to MrExcel!!

Try this (initially on a copy of your data as the results cannot be undone if the results are unexpected):

Option Explicit
Sub Macro1()

    Dim lngRowTo As Long, lngRow As Long
    Dim wsSrc As Worksheet
    
    Application.ScreenUpdating = False
    
    Set wsSrc = ThisWorkbook.Sheets("Sheet1") 'Sheet name containing data. Change to suit.
    lngRowTo = wsSrc.Range("A:E").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    'Sort the data by Last Name, First Name (ascending) and Date Completed (descending)
    With wsSrc.Sort
        With .SortFields
            .Clear
            .Add Key:=Range("A2:A" & lngRowTo), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=Range("B2:B" & lngRowTo), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=Range("D2:D" & lngRowTo), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        End With
        .SetRange wsSrc.Range("A1:E" & lngRowTo)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    'Delete duplicated rows
    For lngRow = lngRowTo To 2 Step -1
        If wsSrc.Range("A" & lngRow) = wsSrc.Range("A" & lngRow - 1) And wsSrc.Range("B" & lngRow) = wsSrc.Range("B" & lngRow - 1) And wsSrc.Range("C" & lngRow) = wsSrc.Range("C" & lngRow - 1) And wsSrc.Range("E" & lngRow) = wsSrc.Range("E" & lngRow - 1) Then
            wsSrc.Rows(lngRow).Delete
        End If
    Next lngRow
    
    Application.ScreenUpdating = True
    
End Sub

Regards,

Robert

 

[loddydoddy81]

Hi Robert,

Thanks for the welcome and the help, much appreciated!!

So looks like the sorting part did work.

But, for some reason, it didn't seem to delete the duplicates. I looked at Nick Fury's and Tony Stark's, they still had both instances of the training with the dates in descending order; so order was correct but just didn't delete.
Would it maybe be because there's nothing in the code for Column D? Like it says:
If wsSrc.Range("A" & lngRow) = wsSrc.Range("A" & lngRow - 1) And wsSrc.Range("B" & lngRow) = wsSrc.Range("B" & lngRow - 1).....etc,.... I see Column's A, B, C, and E mentioned, but nothing about Column D.

 

[Trebor76]

Thanks for the welcome and the help, much appreciated!!

You're welcome

But, for some reason, it didn't seem to delete the duplicates. Would it maybe be because there's nothing in the code for Column D?

That's odd as it worked for me

I purposely left Col. D out or else only Mr Stark would be deleted. Are the course names all the same (as in your screen shot) or are they actually different in your data? Also check for spaces in some text but not others.

If the issue persists please use the "Upload Mini-sheet" button to upload the data you're working with (ensuring it is devoid all any sensitive data).

Thanks,

Robert

 

[loddydoddy81]

You're welcome



That's odd as it worked for me

I purposely left Col. D out or else only Mr Stark would be deleted. Are the course names all the same (as in your screen shot) or are they actually different in your data? Also check for spaces in some text but not others.

If the issue persists please use the "Upload Mini-sheet" button to upload the data you're working with (ensuring it is devoid all any sensitive data).

Thanks,

Robert

So there's about 12 different courses loaded to each person, all under Column E. So it would look like this after the code I already have has done its part:
Col A Col B Col C Col D Col E
Last First Title Date C/W Course Name
Banner Bruce Mr 3/22/2022 Superhero 101
Banner Bruce Mr 3/9/2022 Superhero 102
Banner Bruce Mr 3/22/2017 Superhero 102
Banner Bruce Mr 2/12/2019 Intro to Anger Mgmt
Banner Bruce Mr *date is blank as he hasn't taken the course* Intro to Anger Mgmt
Fury Nick Mr 2/1/2018 Superhero 101
Fury Nick Mr 2/1/2018 Superhero 101
Fury Nick Mr 2/5/2022 Superhero 102
Fury Nick Mr 8/1/2017 Intro to Anger Mgmt
Etc, etc,.

 

[loddydoddy81]

So in the above example, Bruce's 3/22/2017 date for Superhero 102 should be deleted. Either one of Nick's 2/1/2018 for Superhero 101 should be deleted. Etc, etc,.

 

[loddydoddy81]

So in the above example, Bruce's 3/22/2017 date for Superhero 102 should be deleted. Either one of Nick's 2/1/2018 for Superhero 101 should be deleted. Etc, etc,.

Sorry I made a mistake in my fake example. Bruce HAS c/w Intro to Anger Mgmt, but one is an old date and one could be he's attempted to do the class again as an every 3 year requirement and never finished it. In that case, it's ok to keep the one with the date and delete the row with the blank date, as my report will show that 2019 date as being no longer a valid date and he needs to do the course again or finish taking it.

Hope that makes sense.

 

[Trebor76]

See how this goes:

Option Explicit
Sub Macro1()

    Dim lngRowTo As Long, lngRow As Long
    Dim wsSrc As Worksheet
    
    Application.ScreenUpdating = False
    
    Set wsSrc = ThisWorkbook.Sheets("Sheet1") 'Sheet name containing data. Change to suit.
    lngRowTo = wsSrc.Range("A:E").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    'Sort the entire dataset
    With wsSrc.Sort
        With .SortFields
            .Clear
            .Add Key:=Range("A2:A" & lngRowTo), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=Range("B2:B" & lngRowTo), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=Range("C2:C" & lngRowTo), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=Range("D2:D" & lngRowTo), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            .Add Key:=Range("E2:E" & lngRowTo), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        End With
        .SetRange wsSrc.Range("A1:E" & lngRowTo)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    'Delete rows where...
    For lngRow = lngRowTo To 2 Step -1
        '...there's no date or course name
        If Len(wsSrc.Range("D" & lngRow)) = 0 And Len(wsSrc.Range("E" & lngRow)) = 0 Then
            wsSrc.Rows(lngRow).Delete
        Else
            '...or the last name, first name, title and course name of the current row (lngRow) is the same as the row immediately above it
            If wsSrc.Range("A" & lngRow) = wsSrc.Range("A" & lngRow - 1) And wsSrc.Range("B" & lngRow) = wsSrc.Range("B" & lngRow - 1) And wsSrc.Range("C" & lngRow) = wsSrc.Range("C" & lngRow - 1) And wsSrc.Range("E" & lngRow) = wsSrc.Range("E" & lngRow - 1) Then
                wsSrc.Rows(lngRow).Delete
            End If
        End If
    Next lngRow
    
    Application.ScreenUpdating = True
    
End Sub

 

[loddydoddy81]

Ok, so I tried that, still didn't work correctly or at all. I think it might have deleted one or two; so it might kinda be working. What I did notice in the code you posted the second time with the green writing. The part that says ...."course name of the current row (lngRow) is the same as the row immediately above it". Not all the dates are the same. If you see my example, Fury, Parker, and Stark have duplicates of the same course - Fury and Parker have two different dates and it needs to delete the older of the two and Stark has a duplicate date of the same course and it needs to delete that as well. Is the code supposed to be doing that or am I correct that it's not set to do that?

 

[Trebor76]

I need to use the data you're using. Can you use this link to see how to post the data?