VBA code for below use case

[shreyash_shirbhate]

Hi Guys,

I have a excel sheet where I have columns like below image. I want all the unique fruit names to be in a single column and along with that the quantity should add up.

Please check the below screenshot and let me know in case of any other things needed from my end.

[shreyash_shirbhate]

@Sudharsan_Ka @supermanPunch @Anil_G @ppr @ushu

[supermanPunch (Arpan)]

Hi @shreyash_shirbhate ,

Do you need the solution to be using a VBA Code only ?

[shreyash_shirbhate]

Yes, I need a VBA code for this @supermanPunch

[ByteBreaker]

Here you go

Sub SumQuantitiesByFruit()
Dim ws As Worksheet
Dim lastRow As Long
Dim fruitDict As Object
Dim fruitName As String
Dim quantity As Double
Dim i As Long

Set ws = ThisWorkbook.Worksheets("Sheet1") ' Replace "Sheet1" with the actual name of your worksheet
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

' Create a dictionary to store unique fruit names and their quantities
Set fruitDict = CreateObject("Scripting.Dictionary")

' Loop through the data in columns A, B, C, and D
For i = 3 To lastRow
    ' Read the fruit name and quantity from columns A, B, C, and D
    fruitName = ws.Cells(i, "A").Value
    quantity = ws.Cells(i, "B").Value
    
    ' Check if the fruit name exists in the dictionary
    If fruitDict.Exists(fruitName) Then
        ' If the fruit name exists, add the quantity to the existing value
        fruitDict(fruitName) = fruitDict(fruitName) + quantity
    Else
        ' If the fruit name is not in the dictionary, add it as a new key with the quantity as value
        fruitDict.Add fruitName, quantity
    End If
    
    ' Repeat the same process for columns C and D
    fruitName = ws.Cells(i, "C").Value
    quantity = ws.Cells(i, "D").Value
    
    If fruitDict.Exists(fruitName) Then
        fruitDict(fruitName) = fruitDict(fruitName) + quantity
    Else
        fruitDict.Add fruitName, quantity
    End If
Next i

' Output the unique fruit names and their total quantities in columns G and H
ws.Range("G3").Resize(fruitDict.Count, 1).Value = WorksheetFunction.Transpose(fruitDict.Keys)
ws.Range("H3").Resize(fruitDict.Count, 1).Value = WorksheetFunction.Transpose(fruitDict.Items)

End Sub

Ouput