If-And (?) Loop construction (?) to delete multiple rows based on multiple conditions?

[Lil2606]

Hi all,

I am struggling with this for a while... I have the following excel sheet as an example data set

Column A Column B Column C Column D
1 First names Last names Fruits Basket sizes
2 John Smith Raspberry 03 - Basket
3 John Smith Raspberry 05 - Basket
4 John Smith Raspberry 03 - Basket
5 John Smith Cherry Small Basket
6 John Smith Raspberry 03 - Basket
7 Jane Doe Raspberry 03 - Basket
8 Jane Doe Raspberry Small Basket
9 John Page Apple 03 - Basket
10 John Page Apple 03 - Basket
11 John Page Apple Small Basket
12 John Page Apple 05 - Basket
13 Grace Smith Raspberry 03 - Basket
14 Grace Smith Apple 05 - Basket
15 Grace Smith Cherry Small Basket

This is a table, so a listobject, and first row is header row (pretty obviously)
What I would like to do is write a VBA code to get rid of lines that are the same first and last name, and the same fruit, and only keep 1 line (remove duplicates/triplicates)
Either ignoring what is in Column D, or possibly, if there is an 05-Basket, that should be the line that is kept, if there is no "05*" it doesn't matter which line is kept. Also if it can't be done this way and lets say its always the first or last row of the group that is kept that is also good I will just sort it first. (Additional info, there will never be more than one 05 - Basket for the same name and fruit)
So the optimal outcome of this would be:

Column A Column B Column C Column D
1 First names Last names Fruits Basket sizes
2 John Smith Raspberry 05 - Basket
3 John Smith Cherry Small Basket
4 Jane Doe Raspberry 03 - Basket
5 John Page Apple 05 - Basket
6 Grace Smith Raspberry 03 - Basket
7 Grace Smith Apple 05 - Basket
8 Grace Smith Cherry Small Basket

I'm open to any creative solutions.. maybe a column could be inserted as "sorting column" in which the first names, last names and fruits are combined? And based on that column delete duplicates/triplicates?

If empty rows are left, that's also fine I will get rid of them after.

I really just need to figure out how to get rid of the unnecessary rows.. its weeks that I am trying to do this but I am quite new to VBA so its a bit above me yet.. hence if you have a solution, could you also give an explanation on how it does what it does please? I would like to learn.
Please help!
Thank you!

 

[Fluff]

How about

Sub Lil2606()
   Dim Cl As Range, Rng As Range
   Dim ValU As String
   
   With CreateObject("scripting.dictionary")
      .CompareMode = 1
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         ValU = join(Application.Index(Cl.Resize(, 3).Value, 1, 0), "|")
         If Not .Exists(ValU) Then
            .Add ValU, Cl.Offset(, 3).Value
         Else
            If Rng Is Nothing Then Set Rng = Cl.Resize(, 4) Else Set Rng = Union(Rng, Cl.Resize(, 4))
         End If
      Next Cl
   End With
   If Not Rng Is Nothing Then Rng.Delete
End Sub

This will leave the first duplicate & remove the rest

 

[cnestg8r]

This macro doesn't give 05 basket size the requested priority.

If you substitute "Small" with "00Small", you can simply sort descending on size, and the use the built in remove duplicates. This gives me the requested results.

 

[Fluff]

This macro doesn't give 05 basket size the requested priority.

I know, that's why I said

This will leave the first duplicate & remove the rest

Also be warned that using "Remove Duplicates" on multiple columns does not always give the expected results. So I would not recommend using it.

 

[Lil2606]

Oh wow this works thats amazing!! THANK YOU!!

Can you explain your code a little bit, so that I could learn from it? I understand "With...End With" is a form of looping.. and thats about all that I understand in this code..

 

[Lil2606]

Also be warned that using "Remove Duplicates" on multiple columns does not always give the expected results. So I would not recommend using it.

It is incredibly important that there is no data loss during the process, does that quote mean I should not really use this method?

 

[Fluff]

The "Remove Duplicates" wont always delete rows that you expect to be deleted, so may still have rows you don't want.

 

[Lil2606]

Ah thats okay.. As long as nothing gets lost it should be okay, I will go through the data manually as well, but if we have 600 rows to go through and find all duplicates or 50 that's slightly different.

 

[Lil2606]

This macro doesn't give 05 basket size the requested priority.

If you substitute "Small" with "00Small", you can simply sort descending on size, and the use the built in remove duplicates. This gives me the requested results.

Thank you where would I replace "Small" with "00Small"? There is no "Small" anywhere in that code? Or am I blind?

 

[Fluff]

If you are happy sorting the table then this will leave the 05 Baskets

Sub Lil2606()
   Dim Cl As Range, Rng As Range
   Dim ValU As String
   
   With Worksheets("Data").ListObjects("Table1").Sort
      .SortFields.Clear
      .SortFields.Add Key:=Range("Table1[Basket size]"), _
         SortOn:=xlSortOnValues, Order:=xlAscending, _
         CustomOrder:="05 basket", DataOption:=xlSortNormal
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With

   With CreateObject("scripting.dictionary")
      .CompareMode = 1
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         ValU = join(Application.Index(Cl.Resize(, 3).Value, 1, 0), "|")
         If Not .Exists(ValU) Then
            .Add ValU, Nothing
         Else
            If Rng Is Nothing Then Set Rng = Cl.Resize(, 4) Else Set Rng = Union(Rng, Cl.Resize(, 4))
         End If
      Next Cl
   End With
   If Not Rng Is Nothing Then Rng.Delete
End Sub