CODEWITHSUNDEEP
vbaexcelmacros
Ashley
Ashley

Reputation: 157

Excel macro - data manipulation

I am new to macros and I need help for the below.

enter image description here

I have the values as above. I want to count the total number of apples, oranges, and so on. I want the final result in another sheet as below Apples = 15 Banana = 17 Mangoes = 15 Oranges = 13 Melon = 7

I understand that I need to first split them and store them in an array and loop to count them. But I am not sure how to do it. Please help! Thanks!

Upvotes: 1

Views: 203

Answers (2)

user3819867
user3819867

Reputation: 1120

Public Function ConcatResults(rng As Range) As String
Dim rng1 As Range, tmpArray() As String, nameArray() As String, sumArray() As Double, counter As Long
For Each rng1 In rng 'for each cell in your range
    If InStr(rng1.Value2, "=") > 0 Then 'if it contains an equal sign
        tmpArray = Split(rng1.Value2, "=") 'the cell value gets split by the equal sign
        If NameIndex(tmpArray(0), nameArray) > -1 Then 'if the fruit name is found already in the name array
           sumArray(NameIndex(tmpArray(0), nameArray)) = sumArray(NameIndex(tmpArray(0), nameArray)) + CDbl(tmpArray(1)) 'then it adds the number to the existing name's corresponding sum
        Else 'otherwise
            ReDim Preserve nameArray(counter) 'it expands the array of fruit names
            ReDim Preserve sumArray(counter) 'and the corresponding sum array
            nameArray(counter) = tmpArray(0) 'adds the name to the last (open) place in the name array
            sumArray(counter) = CDbl(tmpArray(1)) 'adds the name to the last (open) place in the sum array
            counter = counter + 1 'increments the index for further potential list items
        End If
    End If
Next rng1
'exports data
For i = LBound(nameArray) To UBound(nameArray) 'for the whole set
    ConcatResults = ConcatResults & nameArray(i) & " = " & sumArray(i) & " " 'it concatenates [NAME] = [SUM]
Next i

ConcatResults = Left(ConcatResults, Len(ConcatResults) - 1) 'removes the ending space

End Function
Function NameIndex(str As String, arr() As String) As Long 'this function tells the index of the given string (fruit) in the [name]array
'defaults to -1
NameIndex = -1
On Error GoTo err 'if the array is not yet defined it outputs the default -1
For i = LBound(arr) To UBound(arr) 'for each item in the set
    If arr(i) = str Then NameIndex = i 'if it's the same as the item we're looking for then outputs its index
Next i
err:
End Function

The output is Apples = 15 Oranges = 13 Mangoes = 15 Banana = 12 Bananas = 5 Melon = 7, note Bananas = 5 comes from a typo in the description.

Upvotes: 3

Glitch_Doctor
Glitch_Doctor

Reputation: 3034

UPDATED WITH FIX TO SUBSCRIPT OUT OF RANGE AND TO PICK UP ANOMALIES +/- 's'

Providing you only have 5 items as in your example, otherwise I would create arrays for the items to store the totals, looping through the array each time to see whether the next item already exists in the array to add the total up and adding it to the array if not.

Sub test()

Dim arr As Variant
Dim n, Apples, Oranges, Banana, Mangoes, Melon As Integer

Apples = 0
Oranges = 0
Banana = 0
Mangoes = 0
Melon = 0

n = 0
For Each Cell In Sheets(1).UsedRange.Cells
    If IsEmpty(Cell) Then GoTo 0

    arr = Split(Cell, "=")

    If Left(arr(0), 5) = "Apple" Then
    Apples = Apples + arr(1)
    End If

    If Left(arr(0), 6) = "Orange" Then
    Oranges = Oranges + arr(1)
    End If

    If Left(arr(0), 6) = "Banana" Then
    Banana = Banana + arr(1)
    End If

    If Left(arr(0), 5) = "Mango" Then
    Mangoes = Mangoes + arr(1)
    End If

    If Left(arr(0), 5) = "Melon" Then
    Melon = Melon + arr(1)
    End If

0
Next

Sheets(2).Cells(1, 2).Value = Apples
Sheets(2).Cells(2, 2).Value = Oranges
Sheets(2).Cells(3, 2).Value = Banana
Sheets(2).Cells(4, 2).Value = Mangoes
Sheets(2).Cells(5, 2).Value = Melon

End Sub

Upvotes: 1

Related Questions