Create an array removing duplicates from list but keeping last occurence

Hey everyone,

looking at the attached file what I like to do is this:

Create an array deleting duplicate names and keeping only the last occurance of that name (this array will then be pasted to a new worksheet)

The array must contain the following columns

| NAME | FRUIT | RESULT | (No days)

So for example one row will contain

| William | Watermelon | Watermelon+Orange+Peach |

1. Copy the table to a new sheet.
2. Sort ascending against column A.
3. Insert the formula into E2 (in italian):

Code:

---

=CONFRONTA([@Name];[Name];1)

---

(or in english)

Code:

---

=MATCH([@Name],[Name],1)

---

If necessary, copy it down.

4. Insert the formula into F3 (in italian):

Code:

---

=SE(E2<>E3;E2;0)

---

( in english)

Code:

---

=IF(E2<>E3,E2,0)

---

If necessary, copy it down.

5. Filter the column F, filter criterion = 0.
6. Delete visible lines.
7. Remove column C and E: F.

Now just write it in VBA. :)

Artik

This:

Code:

---

Sub blah()
a = Range("A2:B24").Value
For i = UBound(a) To 1 Step -1
  If Not IsEmpty(a(i, 1)) Then
    For j = i - 1 To 1 Step -1
      Debug.Print i, j
      If a(i, 1) = a(j, 1) Then
        a(i, 2) = a(i, 2) & "+" & a(j, 2)
        a(j, 1) = Empty
      End If
    Next j
  End If
Next i
Results = a
j = 0
For i = 1 To UBound(a)
  If Not IsEmpty(a(i, 1)) Then
    j = j + 1
    Results(j, 1) = a(i, 1)
    Results(j, 2) = a(i, 2)
  End If
Next i
Range("F2").Resize(j, UBound(a, 2)).Value = Results
End Sub

---

results in:
Attachment 26299
at cell F2, is that correct?

Having just seen Artik's answer, I might have got it wrong.
An alternative to Artik's:

1. In cell E2 enter a 1
2. In cell E3 enter a 2
3. Select E2:E3 and autofill down
4. Dropdown arrow in column E's header, choose Sort Largest to Smallest
5. On the Data tab, Data Tools, choose Remove Duplicates
6. In the dialogue box, have only a single tick against the Name column, click OK
7. Dropdown arrow in column E's header, choose Sort Smallest to Largest
8. Delete columns E and Day.

Quote:

---

Originally Posted by p45cal

Having just seen Artik's answer, I might have got it wrong.
An alternative to Artik's:

1. In cell E2 enter a 1
2. In cell E3 enter a 2
3. Select E2:E3 and autofill down
4. Dropdown arrow in column E's header, choose Sort Largest to Smallest
5. On the Data tab, Data Tools, choose Remove Duplicates
6. In the dialogue box, have only a single tick against the Name column, click OK
7. Dropdown arrow in column E's header, choose Sort Smallest to Largest
8. Delete columns E and Day.

---

Why you say you got it wrong?

Your code seems to work fine to me

Quote:

---

Originally Posted by kiltro

Why you say you got it wrong?

---

Because my first answer only uses the first 2 columns and produces an array, (creates something like column D from column B) whereas Artik's and my second answer use the results you've already got in column D

Quote:

---

Originally Posted by p45cal

Because my first answer only uses the first 2 columns and produces an array, (creates something like column D from column B) whereas Artik's and my second answer use the results you've already got in in column D

---

Got it thanks!

I'm trying to translate p45cal last method in VBA but unfortunately it seems RemoveDuplicates doesnt work on mac even if you define a column (Columns:=1) the window where you select the column keeps popout.

Is there a solution around this?

Code:

---

    ActiveSheet.ListObjects(1).Range.RemoveDuplicates Columns:=1, Header:=xlYes

---

Is it working?

Artik

Quote:

---

Originally Posted by Artik

Code:

---

    ActiveSheet.ListObjects(1).Range.RemoveDuplicates Columns:=1, Header:=xlYes

---

Is it working?

Artik

---

As I said unfortunately on mac osx it seems it does not, when the code reaches that line it popsout this window:

Attachment 26310

A VBA version of my suggestion in msg#4 could be:

Code:

---

Sub blah()
With ActiveSheet.Range("A1").ListObject
  Set newColm = .ListColumns.Add
  With newColm.DataBodyRange
    .Cells(1) = 1
    .DataSeries
  End With
  .Range.Sort key1:=newColm.Range, order1:=xlDescending, Header:=xlYes
  .Range.RemoveDuplicates Columns:=1, Header:=xlYes
  .Range.Sort key1:=newColm.Range, order1:=xlAscending, Header:=xlYes
  newColm.Delete
  .ListColumns("Day").Delete
End With
End Sub

---

and this works fine on a PC.
Remove Duplicates in vba seems to be a known problem on the Mac versions of Excel
It's a shame it doesn't work on a Mac because it is fast and efficient.
So we have to grow our own 'remove duplicates' procedure, and while we're at it, remove the duplicates from the top so we don't have to bother sorting:

Code:

---

Sub blah2()
Dim rngToDelete As Range
With ActiveSheet.Range("A1").ListObject '<<<< adjust this so you're looking at the right table.
  x = .ListColumns(1).DataBodyRange.Value
  For i = 1 To UBound(x)
    y = Application.Match(x(i, 1), x, 0)
    If y < i Then
      x(y, 1) = "¬!"
      If rngToDelete Is Nothing Then Set rngToDelete = .ListRows(y).Range Else Set rngToDelete = Union(rngToDelete, .ListRows(y).Range)
    End If
  Next i
  If Not rngToDelete Is Nothing Then rngToDelete.Delete
  .ListColumns("Day").Delete
End With
End Sub

---

However, at this stage, I'd have thought that my snippet in msg#3 is easier and faster.