VBA "Sum and merge" a dynamic range - excel

Question

I want to get a sum based on the criteria of the preceding column data. Suppose I have three columns say A, B and C. So, "A" columns have the Sr.no. let's say, "B" has the quantity and "C" have the total quantity. I am trying to sum the quantity in column "B" based on the Sr.no. in column "A" and paste it to column "C" (after merging that many cells) against the respective Sr.no. (Which we have in column "A"). Refer image attached Image.
Sub sum_on_condition()
Dim sum_criteria As Double
Dim lastrow As Long, x As Long
Dim l_array As Variant
Dim l_number As Long
lastrow = range("A" & Rows.Count).End(xlUp).Row
l_array = range("I2:I21").Value
counter = 1
While counter <= UBound(l_array)
l_number = l_array(counter, 1)
For x = 2 To lastrow
If range("e" & x).Value = l_number Then
sum_criteria = sum_criteria + range("f" & x).Value
End If
Next x
counter = counter + 1
Wend
Debug.Print sum_criteria
End Sub
I have written this code but what it does it sums the total value rather than the individual value. I am not able to figure out how I do this!

Answer 1

Here's another approach:
Sub SumAndMerge()
Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Long
Dim firstItem As Long, lastItem As Long
Dim i As Long, j As Long
Dim c As Range, d As Range
Dim valueToFind As String
Dim total As Long
Set wb = ThisWorkbook
Set ws = wb.Sheets(1)
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow
'Get valueToFind
valueToFind = ws.Cells(i, 1).value
'Get range of cells with .Find : look up for first value and last value and get row number.
With ws.Range("A" & i & ":" & "A" & lastRow)
Set c = .Find(valueToFind, LookAt:=xlWhole)
firstItem = c.Row - 1
Set d = .Find(valueToFind, LookAt:=xlWhole, SearchDirection:=xlPrevious)
lastItem = d.Row
End With
'Get total
total = WorksheetFunction.Sum(ws.Range("B" & firstItem & ":" & "B" & lastItem))
'Assign total to first cell
ws.Range("C" & firstItem).value = total
'Merge cells
ws.Range("C" & firstItem & ":" & "C" & lastItem).Merge
'Go to lastItem to adapt the loop
i = lastItem
Next i
End Sub
Gives the following output:
Rather than using an array, this macro aims at using the Find function. In a loop, we find the first value and the last value. We extract row numbers and then we can assign the total and finally merge cells.
This code can be improved by replacing harcoded A, B and C. But this gives you an example.