Sub Totals by Year VBA

Panoos64 · Jun 10, 2019

Hi to all of you, kindly require to provide me support for a VBA code so that, to prepare “Sub Totals” per year base on Col. “A” but starting from “A13” till last completed row. I present below the original data and expected result. Thank you all in advance

Original

	A	B	C	D
1	Date	Sale	Cost of Sale	Gross Profit
13	15/01/2017	1,000	500	500
14	22/01/2017	1,250	850	400
15	29/01/2017	1,150	630	520
16	05/02/2017	1,283	615	668
17	12/02/2017	1,358	680	678
18	19/02/2017	1,433	693	741
19	02/03/2017	1,508	705	803
20	28/03/2017	1,583	718	866
21	12/03/2017	1,658	730	928
22	19/03/2017	1,733	743	991
23	26/03/2017	1,808	755	1,053
24	02/04/2017	1,883	768	1,116
25	09/04/2017	1,958	780	1,178
26	16/04/2017	2,033	793	1,241
27	23/04/2017	2,108	805	1,303
28	30/04/2017	2,183	818	1,366
29	09/01/2018	1,650	750	900
30	15/01/2018	1,345	733	612
31	31/01/2018	1,110	730	380
32	02/02/2018	1,254	655	599
33	17/02/2018	1,358	695	663
34	25/02/2018	1,524	705	819
35	26/02/2018	1,647	752	895
36	01/03/2018	1,487	745	742
37	10/03/2018	1,752	710	1,042
38	25/03/2018	1,625	769	856
39	27/03/2018	1,910	699	1,211
40	31/03/2018	1,745	712	1,033
41	05/04/2018	2,020	847	1,173
42	15/04/2018	1,780	762	1,018
43	25/04/2018	1,899	812	1,087
44	29/04/2018	1,905	955	950

Expected result

	A	B	C	D
1	Date	Sale	Cost of Sale	Gross Profit
13	15/01/2017	1,000	500	500
14	22/01/2017	1,250	850	400
15	29/01/2017	1,150	630	520
16	05/02/2017	1,283	615	668
17	12/02/2017	1,358	680	678
18	19/02/2017	1,433	693	741
19	02/03/2017	1,508	705	803
20	28/03/2017	1,583	718	866
21	12/03/2017	1,658	730	928
22	19/03/2017	1,733	743	991
23	26/03/2017	1,808	755	1,053
24	02/04/2017	1,883	768	1,116
25	09/04/2017	1,958	780	1,178
26	16/04/2017	2,033	793	1,241
27	23/04/2017	2,108	805	1,303
28	30/04/2017	2,183	818	1,366
29	2017-Total	25,933	11,580	14,353
30	09/01/2018	1,650	750	900
31	15/01/2018	1,345	733	612
32	31/01/2018	1,110	730	380
33	02/02/2018	1,254	655	599
34	17/02/2018	1,358	695	663
35	25/02/2018	1,524	705	819
36	26/02/2018	1,647	752	895
37	01/03/2018	1,487	745	742
38	10/03/2018	1,752	710	1,042
39	25/03/2018	1,625	769	856
40	27/03/2018	1,910	699	1,211
41	31/03/2018	1,745	712	1,033
42	05/04/2018	2,020	847	1,173
43	15/04/2018	1,780	762	1,018
44	25/04/2018	1,899	812	1,087
45	29/04/2018	1,905	955	950
46	2018-Total	26,011	12,031	13,980
47	Grand Total	51,945	23,611	28,334

MickG · Jun 10, 2019

Try this:-
NB:- This code will modify the layout of your data.

Code:

[COLOR="Navy"]Sub[/COLOR] MG10Jun28
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] nSum(1 To 3), Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Lst = Range("A" & Rows.Count).End(xlUp).Row
Temp = Year(Cells(Lst, 1))

[COLOR="Navy"]For[/COLOR] n = Lst To 13 [COLOR="Navy"]Step[/COLOR] -1
    [COLOR="Navy"]If[/COLOR] Not Year(Cells(n, 1)) = Temp [COLOR="Navy"]Then[/COLOR]
        Cells(n + 1, 1).EntireRow.Insert
        Temp = Year(Cells(n, 1))
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n

[COLOR="Navy"]Set[/COLOR] Rng = Range("A13", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants)
Lst = Range("A" & Rows.Count).End(xlUp).Row

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Areas
    [COLOR="Navy"]For[/COLOR] n = 0 To 3
        Dn(Dn.Count + 1).Offset(, n) = IIf(n = 0, Year(Dn(1)) & " -Total", Application.Sum(Dn.Offset(, n)))
        [COLOR="Navy"]If[/COLOR] Not n = 0 [COLOR="Navy"]Then[/COLOR]
        nSum(n) = nSum(n) + Application.Sum(Dn.Offset(, n))
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] Dn
     [COLOR="Navy"]For[/COLOR] n = 0 To 3
        [COLOR="Navy"]If[/COLOR] n = 0 [COLOR="Navy"]Then[/COLOR]
          Cells(Lst + 2, 1).Offset(, n) = "Grand Total"
        [COLOR="Navy"]Else[/COLOR]
          Cells(Lst + 2, 1).Offset(, n) = nSum(n)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

Panoos64 · Jun 10, 2019

Perfect work Mick! thenka so much for your time spent for my project. Hv a great day

MickG · Jun 11, 2019

You're welcome

Sub Totals by Year VBA

Panoos64

Well-known Member

Excel Facts

MickG

MrExcel MVP

Panoos64

Well-known Member

MickG

MrExcel MVP

Similar threads

Forum statistics

Share this page

Sub Totals by Year VBA

Panoos64

Well-known Member

Excel Facts

MickG

MrExcel MVP

Panoos64

Well-known Member

MickG

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock