macro to add value in cells corresponding to same category

Home / Uncategorized / macro to add value in cells corresponding to same category

Question:
I am fairly new to macro-VBA . It could be very helpful if some one could guide me in the following.

I have a data-set that has category name in column A and in column B the corresponding values. It looks somewhat like this

Based on the category name in column A, I should get a sum of values present in B. that is if cells A1:A3 belongs to category "a", values present in B1:B3 should be summed and the corresponding rows should be merged in column C and the resultant sum should be displayed in column C Output should look like this

I tried to code using in the following way
Sub main()
Dim i As Long
Dim a As Long ‘

Dim sum As Long
sum = 0
Dim samerows As Boolean
samerows = True
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row

If StrComp(Cells(i, 1), Cells(i + 1, 1), vbTextCompare) Then
samerows = False
End If

If samerows Then
sum = sum + Cells(i, 1).Value
Range(Cells(i, 2), Cells(i + 1, 2)).Merge
End If

samerows = True
Cells(i, 2).Value = sum
Next i

End Sub

But this code is wrong as I am unable to provide proper cell reference values.

It would be of great help, if some one could share their thoughts and guide me with a code


Answer:
Trying to keep as close to your style as code as possible, I added a count of the number of cells that is needed to ensure that you reference the top left cell in any field of merged cells (as this is where Excel stores the values), as well as added a few more summary instances. Please try the following:Sub main()
Dim i As Long
Dim a As Long ‘

Dim sum As Long
Dim mergeCnt As Long
mergeCnt = 0
sum = 0
Dim samerows As Boolean
samerows = True
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row

If StrComp(Cells(i, 1), Cells(i + 1, 1), vbTextCompare) Then
sum = sum + Cells(i, 2).Value
samerows = False
End If
Debug.Print (sum)
If samerows Then
sum = sum + Cells(i, 2).Value
Range(Cells(i, 3), Cells(i + 1, 3)).Merge
mergeCnt = mergeCnt + 1
Else:Cells(i – mergeCnt, 3).Value = sum
sum = 0
mergeCnt = 0
End If

samerows = True
Cells(i, 3).Value = sum
Next i

End Sub
Read more

Leave a Reply

Your email address will not be published. Required fields are marked *