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!

 

[loddydoddy81]

Do you need it in the raw format or how it looks after the code I already have does its thing? How it looks after the code I have is the same as it is in the original post; I click a button I have the code linked to makes it in the shown format. If it's the raw format, it's got about 7 more columns that get deleted, the last and first name columns are reversed, etc,.

Just wanna make sure i'm getting you the way you want/need it.

 

[Trebor76]

A before (raw data) and after (you'll have to manually create this for posting here but it will be how the original raw data needs to look like after the macro has run) scenario would be great.

 

[loddydoddy81]

I can't do a Mini-sheet upload from my computer at work. However, i can post how the data looks initially vs how it looks after my code.

Before:

After:

So it gets rid of Columns A, E, F, G, I, J, and L. Then it moves Title to become Column C, moves Last Name to become Column A and moves First Name to become Column B....if that makes sense?

Then I have more code that tells it look in another tab (that is not shown) and reference Column A in this other tab - if it sees certain Course Names from the main tab, it deletes all rows with that course from the main tab.
Then I have another similar code that does the same thing, only it looks for certain Last Names in the un-shown tab and if it finds that last name on the main tab, it deletes all rows with that last name from the main tab.
Then once done it pops up a dialogue box letting you know it's done.

So the code I need from here, to delete duplicates could be before the dialogue box code. It'll further look and say "hey, i see Steve Austin has Training Class 101 twice...which is the older Date Completed? Ah!, 02/03/2021 is, i'll delete that! Ultimate Warrior has 365 Days of Cooking twice....which is older? Hmmm... both the same, i'll just delete the bottom one. Hulk Hogan has Intro To Cooking twice, i'll delete 09/25/2019" etc, etc,.

 

[Trebor76]

That wasn't the before and after scenario I was after. It should have been from your second screen show to after the desired rows were deleted.

In any case the following code will delete the three rows highlighted in yellow (before) to the second screen shot (after).

I notice that the dates in your screen shots are left justified. That tells me they are actually strings not dates so that could be impacting on the results. To test use the DATEVALUE function on them and if any return a number they are strings so make sure they are true dates.

Beyond that I can't offer any more help I'm afraid. All the best with it.

Regards,

Robert

Option Explicit
Sub Macro1()

    'https://www.mrexcel.com/board/threads/vba-code-to-delete-duplicate-rows-based-off-data-from-other-columns.1199898/page-2#posts

    Dim lngRowTo As Long, lngRow As Long
    Dim wsSrc As Worksheet
    
    Application.ScreenUpdating = False
    
    Set wsSrc = ThisWorkbook.Sheets("Sheet2") '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:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=Range("E2:E" & 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 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 Trim(wsSrc.Range("A" & lngRow)) = Trim(wsSrc.Range("A" & lngRow - 1)) And Trim(wsSrc.Range("B" & lngRow)) = Trim(wsSrc.Range("B" & lngRow - 1)) And Trim(wsSrc.Range("C" & lngRow)) = Trim(wsSrc.Range("C" & lngRow - 1)) And Trim(wsSrc.Range("D" & lngRow)) = Trim(wsSrc.Range("D" & lngRow - 1)) Then
                wsSrc.Rows(lngRow).Delete
            End If
        End If
    Next lngRow
    
    Application.ScreenUpdating = True
    
End Sub

 

[bebo021999]

Try to use dictionary to get unique first-last name-course, then get the newest date
also sort by Last, then first name, then course

Option Explicit
Sub test()
Dim lr&, k&, cell As Range, id As String, dic As Object, key, arr()
Set dic = CreateObject("Scripting.dictionary")
lr = Cells(Rows.Count, "A").End(xlUp).Row
    For Each cell In Range("A2:A" & lr)
        id = cell & "|" & cell.Offset(0, 1) & "|" & cell.Offset(0, 2) & "|" & cell.Offset(0, 4)
        If Not dic.exists(id) Then
            dic.Add id, cell.Offset(0, 3).Value
        ElseIf dic(id) < cell.Offset(0, 3).Value Then dic(id) = cell.Offset(0, 3).Value
        End If
    Next
        ReDim arr(1 To dic.Count, 1 To 5)
        For Each key In dic.keys
            k = k + 1
            arr(k, 1) = Split(key, "|")(0)
            arr(k, 2) = Split(key, "|")(1)
            arr(k, 3) = Split(key, "|")(2)
            arr(k, 4) = dic(key)
            arr(k, 5) = Split(key, "|")(3)
        Next
Range("A2:E" & lr).ClearContents
With Range("A2").Resize(k, 5)
    .Value = arr
    .Sort Range("A1"), , Range("B1"), , , Range("E1")
End With
End Sub

 

[loddydoddy81]

I don't quite know how to quote both of the last replies and it will only let me choose one solution but i tried both and both do what i need it to do. so thanks to you both!!!