-
You can change the vblf to vbcrlf if needed. If I understand correctly:
[VBA]Sub SumFruitCells()
Dim s() As String, r As Range, cell As Range
Set r = Range("A1:Z100")
For Each cell In r
s() = SumFruits(cell.Value)
cell.Value = Join(s(), vbCrLf)
Next cell
End Sub
Function SumFruits(fruitString As String)
Dim a() As String, b() As String, c() As String
Dim u() As String, aFruit() As String, aCount() As String, aFruitCount() As String
Dim i As Integer, j As Integer, coll As New Collection
Dim sCount As Double, iCount As Integer
'Split and make arrays with fruit names and quantities.
a() = Split(Replace(fruitString, ",", ""), vbLf)
b() = a()
c() = a()
'Remove duplicate fruit names and put in collection.
On Error Resume Next
For i = 0 To UBound(a)
b(i) = Split(a(i))(0)
c(i) = Split(a(i))(1)
coll.Add b(i), b(i)
Next i
On Error GoTo 0
ReDim u(0 To coll.Count)
'Build the union array of "Fruit Names-Sum(Count)".
For j = 1 To coll.Count
sCount = 0
iCount = 0
For i = 0 To UBound(b)
If coll(j) = b(i) Then
sCount = sCount + c(i)
iCount = iCount + 1
End If
Next i
u(j) = coll(j) & "-" & sCount & "(" & iCount & ")"
Next j
SumFruits = u()
End Function
[/VBA]
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules