Generate a string of combined words without duplicates

I have a table with some delicious fruits :) But a fruit can occurre for several times in that table, for example:

In the final this table can have different fruits with up to 10 rows, so y can have a value from 1 to 10. What I'm struggeling with now, is generating a string in that format:

Apple + Banana x2 + Strawberry

So I want a string with each fruit for only one time. When the fruit occurs more than one time, I want "xAmount" beside the fruit. But with my code, it generates this string:

Apple + Banana x2 + Banana + Strawberry

Depending on the positions of the fruit and the amount of duplicates, the string I need will not be generated...

This is my code:

Dim y As Integer    
Dim Counter1 As Integer
Dim Counter2 As Integer
Dim NewBufferCounter As Integer
Dim a As Integer
Dim ArrayBuffer1(15) As String
Dim NewBuffer(15) As String
Dim FinalString(15) As String
Counter1 = 0
Counter2 = 0
a = 1

'2 nested FOR-Loops to compare the fruits for duplicates
For Counter1 = 0 To (y - 1)
        a = 1
                                     
        For Counter2 = Counter1 + 1 To (y - 1)
                    
                    If (ArrayBuffer1(Counter1) = ArrayBuffer1(Counter2)) And (ArrayBuffer1(Counter1) <> "") And (Counter1 <> Counter2) Then
                    a = a + 1
                    NewBuffer(NewBufferCounter) = ArrayBuffer1(Counter1) & " x" & a                 
                    
                    ElseIf (a = 1) And (ArrayBuffer1(Counter1) <> "") Then
                    NewBuffer(NewBufferCounter) = ArrayBuffer1(Counter1)
                    
                    Else
                    'Do nothing
                    End If
                    
                    If Counter2 = (y - 1) Then
                    NewBufferCounter = NewBufferCounter + 1
                    Else
                    'Do nothing
                    End If
                    
          Next Counter2
                
Next Counter1

'Further IF-Statement because the second FOR-Loop will skipped when "y" equals "1"           
If y = 1 Then
NewBuffer(NewBufferCounter) = ArrayBuffer1(0)
End If


AmountDiffFruits = NewBufferCounter



'Generate the final string I need
  For NewBufferCounter = 0 To AmountDiffFruits
               If (NewBuffer(NewBufferCounter) <> "") Then
                            If (IsEmpty(FinalString(NewBufferCounter))) Then
                            FinalString(0) = NewBuffer(NewBufferCounter)
                            
                            Else
                            FinalString(0) = FinalString(0) & " + " & NewBuffer(NewBufferCounter)
                        
                            End If
              Else
              'Do nothing
              End If
                   
     Next NewBufferCounter
                                    
Erase ArrayBuffer1()
Erase NewBuffer()
Erase FinalString()
NewBufferCounter = 0

Hope anybody has a solution for that... Thank you!

I think this is an excellent case for a Dictionary. A Dictionary is a structure that contains key-value pairs.

The following code will read the list of fruits into a dictionary. It uses the fruit name as key and the counter as value. If it finds a fruit that is already in the dictionary, it increments the counter, else it will add the fruit as new entry into the dictionary and set the counter to 1.

After creating the dictionary, we loop over all keys (=fruits) and build an array of string. If a fruit appeared more than once, it will get the suffix nX (with n being the number how often that fruit appeared).

Finally we use the Join-function to create a string out of it.

Sub ListFruits()
    Dim r As Range, row As Long
    Dim fruitDict As New Dictionary
    Set r = ActiveSheet.Range("A1").CurrentRegion
    For row = 2 To r.Rows.Count
        Dim fruit
        fruit = r.Cells(row, 1)
        If fruitDict.Exists(fruit) Then
            fruitDict(fruit) = fruitDict(fruit) + 1
        Else
            fruitDict.Add fruit, 1
        End If
    Next
    
    ReDim fruitArr(1 To fruitDict.Count) As String
    Dim i As Long
    For Each fruit In fruitDict.Keys
        Dim repeatCount As Long
        repeatCount = fruitDict(fruit)
        i = i + 1
        fruitArr(i) = fruit & IIf(repeatCount <= 1, "", " " & repeatCount & "x")
    Next
    
    Dim myFruitList As String
    myFruitList = Join(fruitArr, " + ")
    Debug.Print myFruitList
End Sub

Note that the Dictionary is not part of the VBA language. As I am a big fan of Early Binding, you will need to add a reference to the Microsoft Scripting.Runtime. Or you use Late Binding and change the definition from fruitDict to:

Dim fruitDict As Object
Set fruitDict = CreateObject("Scripting.Dictionary")