ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Sum after sorting (https://www.excelbanter.com/excel-programming/370869-sum-after-sorting.html)

proton

Sum after sorting
 

I have 3 columns Column A Names, Column B Status and Column C Values.
In Column B i have 2 values Income and Outcome.
I've sorted this A and B Cells

Columns("A:C").Select
Selection.Sort Key1:=Range("A2"), _
Order1:=xlAscending, _
Key2:=Range("B2"), _
Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

I would like to add extra Rows and make Sum for each name create Incom
and Outcome Sums.
For example:
Column A # Column B # Column C #
##########################
Name # Status # Value #
##########################
David # Income # 10 #
##########################
David # Income # 30 #
##########################
David # Income Sum# 40 # <<- This Row Must Be added
##########################
David # Outcome # 50 #
##########################
David # Outcome # 20 #
##########################
David # Outcome Sum# 70 # <<- This Row Must Be added
##########################
Kate # Income # 30 #
##########################

somethinglikeant

Sum after sorting
 
This should do the trick

:================================================= ========

Sub SummationLines()

Columns("A:C").Sort Key1:=Range("A2"), _
Order1:=xlAscending, _
Key2:=Range("B2"), _
Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

[B2].Select

Do Until IsEmpty(ActiveCell)
x = 0
qmark = ActiveCell.Value
Do Until ActiveCell < qmark
x = x + ActiveCell.Offset(0, 1).Value
ActiveCell.Offset(1, 0).Select
Loop
Selection.EntireRow.Insert
ActiveCell.Value = qmark & " Sum"
ActiveCell.Offset(0, 1) = x
ActiveCell.Offset(0, -1) = ActiveCell.Offset(-1, -1).Value
ActiveCell.Offset(1, 0).Select
Loop

End Sub

:================================================= ==


proton

Sum after sorting
 

Thank you very much
Its working.
Is it possible to merge in column A
cells which comtain the same string

--
proto
-----------------------------------------------------------------------
proton's Profile: http://www.excelforum.com/member.php...fo&userid=3680
View this thread: http://www.excelforum.com/showthread.php?threadid=57334



All times are GMT +1. The time now is 01:42 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com