Home > OS >  VBA "Sum and merge" a dynamic range
VBA "Sum and merge" a dynamic range

Time:12-09

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 enter image description here

CodePudding user response:

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:

enter image description here

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.

  • Related