Sum varying length blocks of data

[meetvivek72]

i need your help immediately as i m facing severe problem in adding excel data ,.
Actually i have few sets of data and i want to show the result(sum) in next blank cell to every set of data. I m showing it through example below..

eg:- set1 :

Score
20
19
15
suppose this is the frst set , hence i want the resultant or sum i,e 54(20+19+15) just below 15, the blank cell just next to 15 highlighed

set2:
Score
78
191
131
now suppose in this bunch or set the sum would be 400, thus it should be displayed below the cell showiing 131 value highlighed

and most importantly all these sets are in single sheets and they are in thousands,
attached is the test sheet .....

 

[hiker95]

meetvivek72,

Welcome to the MrExcel forum.


Sample raw data before the macro:

Excel Workbook
	A
1	set1:
2	Score
3	20
4	19
5	15
6
7	set2:
8	Score
9	78
10	191
11	131
12
13
Sheet1

After the macro:

Excel Workbook
	A
1	set1:
2	Score
3	20
4	19
5	15
6	54
7	set2:
8	Score
9	78
10	191
11	131
12	400
13
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub SumAreas()
' hiker95, 06/30/2011
' http://www.mrexcel.com/forum/showthread.php?t=561147
Dim Area As Range, SR As Long, ER As Long
Application.ScreenUpdating = False
For Each Area In Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
  With Area
    SR = .Row
    ER = SR + .Rows.Count - 1
    With Range("A" & ER + 1)
      .Formula = "=SUM(A" & SR + 2 & ":A" & ER & ")"
      .Font.Bold = True
      .Interior.ColorIndex = 6
    End With
  End With
Next Area
Application.ScreenUpdating = True
End Sub

Then run the SumAreas macro.



If the above screenshots are not correct, then:

To attach screenshots, see below in my Signature block: Post a screen shot with one of these:

 

[meetvivek72]

hello dude,

frstly i would thnk u for replying me, Now i like to tell u one thing that the problem which i had mentioned earlier is little bit solved , Actually i dont know the way to add excel sheet in this forum,Thus i have shown only few sets of data. But when i tried ur macro on my workbook it start giving accurate result at few sets , but on most of the sets it given wrong result or 0. I'll again show my data here, then it would be helpfull for u to get an understanding of the issue.
Note: The blank space in each set shows the blank excel lines.

Clumn A

1259
1412
1579
1750





14108
14583
14766
15064
15291
15659




480
819
1240



2261
2618



5501




3002




601
989
1212
1898
2598
2780
3052
4078
4286
5739
6542
6838
7063
8164
8839
9303
9951
10110
10324
11104



17080
18593




974
1422



4851
5060




1081
1619
1800



6119
6660
6840
7219



8724
9809



17045
17646
17908



19125
19401
19603
20884
21020
21257
21870
22177
22708
22954
23198
23390





5929
6725
7663
8482
9499
9717
10626
11317
11778
12065
12342
12814
13015
13411
13856








































If u provide me ur mail Id then i can send u the problem sheet. Waiting for ur reply, ur help will be highly appreciated

 

[hiker95]

meetvivek72,

You have changed the way your data is displayed.


What version of Excel are you using?

You will generally get much more help (and faster) in this forum if you can post your small samples (what you have and what you expect to achieve) directly in the forum.

To attach screenshots, see below in my Signature block: Post a screen shot with one of these:

If you are not able to give us screenshots, see below in my Signature block: You can upload your workbook to Box Net

 

[hiker95]

meetvivek72,


Sample raw data before the macro (not all data shown for brevity):

Excel Workbook
	A
1	1259
2	1412
3	1579
4	1750
5
6
7
8
9
10	14108
11	14583
12	14766
13	15064
14	15291
15	15659
16
17
18
19
20	480
21	819
22	1240
23
24
25
26	2261
27	2618
28
29
30
31	5501
32
33
34
35
36	3002
37
38
Sheet1

After the new macro:

Excel Workbook
	A
1	1259
2	1412
3	1579
4	1750
5	6000
6
7
8
9
10	14108
11	14583
12	14766
13	15064
14	15291
15	15659
16	89471
17
18
19
20	480
21	819
22	1240
23	2539
24
25
26	2261
27	2618
28	4879
29
30
31	5501
32	5501
33
34
35
36	3002
37	3002
38
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub SumAreasV2()
' hiker95, 07/01/2011
' http://www.mrexcel.com/forum/showthread.php?t=561147
Dim Area As Range, SR As Long, ER As Long
Application.ScreenUpdating = False
For Each Area In Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
  With Area
    SR = .Row
    ER = SR + .Rows.Count - 1
    With Range("A" & ER + 1)
      .Formula = "=SUM(A" & SR & ":A" & ER & ")"
      .Font.Bold = True
      .Interior.ColorIndex = 6
    End With
  End With
Next Area
Application.ScreenUpdating = True
End Sub

Then run the SumAreasV2 macro.

 

[meetvivek72]

thnx a lot , its working absolutely fine now,,, thankyou very much................

 

[hiker95]

meetvivek72,

You are very welcome.

Glad I could help.

Thanks for the feedback.

Come back anytime.

 

[meetvivek72]

hi,

i need one more help in addition to ur previous macro, Well it is perfectly working for additon of data,Now please tell me is it possible to delete all rows of the set or bunch where sum (Yellow fields) is below 500.

 

[hiker95]

meetvivek72,

Please post your small samples (what you have in one worksheet and what you expect to achieve in another worksheet) directly in the forum.

To attach screenshots, see below in my Signature block: Post a screen shot with one of these:

If you are not able to give us screenshots, see below in my Signature block: You can upload your workbook to Box Net, and provide us with a link to your workbook.