how to macro to auto sub-total and grand total of manpower plan used in the project

[david2005wang]

I have "manpower plan" sheet, and the No. lists in Column "A from 1 to N (example is from 1 to 3), Month in row 2 from 1 to M (example is from “E” to “P”).
Each time, I need to calculate the subtotal Manpower for each of Team (from 1 to N) including grant total for all teams by each month from 1 to M.
I plan to use VBA codes introduced by two buttons ("insert subtotal", and "grand total") to meet the following purpose.

1 When I click “insert subtotal” button after I put the mouse cursor in the position of active cell (the location of Sub-total) below last row of each team, it will insert one row, copy the format of above row and auto input “Sub-Total” words into the active cell, Change the background color of the row into grey, Draw a thick line under the sub-total row, and finally auto input the subtotal formular to calculate and fill the number of the sub-sum for each of month of each team.

2. when click the “grand total” button, will auto input the grand total formular to calculate and fill the number of the grand sum for each of month of all team.

I try some codes but didn't work well, so, could any expert help me with specific codes to meet the above targets.

Manpower Plan.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	Well Pads Construction Manpower Plan				ED+ Month
2					1	2	3	4	5	6	7	8	9	10	11	12
3	No.	Category	Plan to Start	Plan to End
4	1	Project Management Team
5	1.1	Deputy Project Manager	ED+2	ED+12		1	1	1	1	1	1	1	1	1	1	1
6	1.2	Construction Manager	ED+10	ED+12										1	1	1
7	1.3	Site Manager	ED+6	ED+12						1	1	1	1	1	1	1
8		Sub-Total			0	1	1	1	1	2	2	2	2	3	3	3
9	2	Geotechnical Team
10	2.1	Team Leader	ED+1	ED+9	1	1	1	1	1	1	1	1	1
11	2.2	Geotechnical Engineer	ED+1	ED+3	2	2	2
12	2.3	Topographic Engineer	ED+1	ED+8	2	2	2	2	2	2	2	2
13	2.4	Drilling machine operator	ED+1	ED+11	4	4	4	4	4	4	4	4	4	4	4
14	2.5	Labour	ED+1	ED+3	12	12	12
15	2.6	Administrator	ED+1	ED+12	2	2	2	2	2	2	2	2	2	2	2	2
16		Sub-Total			23	23	23	9	9	9	9	9	7	6	6	2
17	3	Camp Installation Team
18	3.1	Site Manager	ED+10	ED+10										1
19	3.2	Construction Engineer	ED+10	ED+10										1
20	3.3	QHSE Engineer	ED+10	ED+10										1
21		Sub-Total			0	0	0	0	0	0	0	0	0	3	0	0
22		Grand Total			23	24	24	10	10	11	11	11	9	12	9	5
Manpower Plan

Cell Formulas
Range	Formula
E21:P21,E8:P8	E8	=SUBTOTAL(9,E4:E7)
E16:P16	E16	=SUBTOTAL(9,E10:E15)
E22:P22	E22	=SUBTOTAL(9,E4:E21)

 

[david2005wang]

I have writen simple codes to support the three buttons and make the function possible (insert subtotal, grandtotal, deletetotal) referring to attached sheet1. But what i want to say is put the formula Subtotal function into the cells of row of Sub-Total from column E to column P referring to the attached sheet2.. I also consider my code is too complex, and should be more easier code to meet the same functions. could any expert to advices?



Const ColLeft As Long = 5 'manpower plan start month
Const ColRight As Long = 16 'manpower plan finish month

Private Sub Subtotal_Click()

Dim Columa, Rowmaup, Rowmalow, R, C As Long
Dim ws As Worksheet
Columa = ActiveCell.Column
Debug.Print Columa
Rowmalow = ActiveCell.Row
Set ws = Worksheets("Manpower Plan")
If Rowmalow < 5 Or Columa <> 2 Then Exit Sub 'select only Column "B" and Row > 4.

'Find the sub-total range
For R = Rowmalow To 4 Step -1

If ws.Range("B" & R).Value = "Sub-Total" Then
Rowmaup = R + 2 'find the subtotal top row
Exit For
Else
Rowmaup = 5 'if no subtotal in column "B" means it is the first subtotal for top line, find the subtotal top row
End If

Next R

'Insert Sut-Total in the activeCell, and setup the color, fond and borders
ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrAbove
ActiveCell.EntireRow.Copy
ActiveCell.Offset(1).EntireRow.PasteSpecial xlPasteFormats
Application.CutCopyMode = False

'ws.Range("B" & Rowmalow + 1).EntireRow.Insert
ws.Range("B" & Rowmalow + 1) = "Sub-Total"
ws.Range("B" & Rowmalow + 1).Font.Bold = True

ws.Range(Cells(Rowmalow + 1, 1), Cells(Rowmalow + 1, ColRight)).Interior.Color = RGB(211, 211, 211)

'Sub-Total Caculations
For C = ColLeft To ColRight
Cells(Rowmalow + 1, C) = Application.WorksheetFunction.Sum(Range(Cells(Rowmalow, C), Cells(Rowmaup, C)))
Next C

End Sub


Private Sub GrandTotal_Click()

Dim ws As Worksheet
Dim LR As Long
Dim i As Long
Dim Columa As Long

Set ws = Worksheets("Manpower Plan")
LR = ws.Range("B" & Rows.Count).End(xlUp).Row
ws.Range("B" & LR + 1).Value = "Grand Total"
Range(Cells(LR + 1, 1), Cells(LR + 1, ColRight)).Select

With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With

With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With

With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With

With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick

End With

With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick

End With


With Range(Cells(LR + 1, 1), Cells(LR + 1, ColRight))
'.WrapText = True
.Font.Bold = True
End With

For Columa = ColLeft To ColRight Step 1
Cells(LR + 1, Columa) = Application.WorksheetFunction.Sum(Range(Cells(4, Columa), Cells(LR, Columa))) / 2
Next Columa
End Sub


Private Sub DeleteRowTotal_Click()
Dim ws As Worksheet
Dim LR, R As Long
Set ws = Worksheets("Manpower Plan")

LR = ws.Range("B" & Rows.Count).End(xlUp).Row
For R = LR To 4 Step -1
If ws.Range("B" & R).Value = "Sub-Total" Or ws.Range("B" & R).Value = "Grand Total" Then Range("B" & R).EntireRow.Delete
Next R
End Sub

Attached Sheet1

Manpower Plan.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V
1	Well Pads Construction Manpower Plan				ED+ Month
2					1	2	3	4	5	6	7	8	9	10	11	12
3	No.	Category	Plan to Start	Plan to End
4	1	Project Management Team
5	1.1	Deputy Project Manager	ED+2	ED+12		1	1	1	1	1	1	1	1	1	1	1
6	1.1	Deputy Project Manager	ED+2	ED+12		1	1	1	1	1	1	1	1	1	1	1
7	1.2	Construction Manager	ED+10	ED+12										1	1	1
8	1.3	Site Manager	ED+6	ED+12	0	1	1	1	1	2	2	2	2	3	3	3
9		Sub-Total			0	3	3	3	3	4	4	4	4	6	6	6
10	2	Geotechnical Team
11	2.1	Team Leader	ED+1	ED+9	1	1	1	1	1	1	1	1	1
12	2.2	Geotechnical Engineer	ED+1	ED+3	2	2	2
13	2.3	Topographic Engineer	ED+1	ED+8	2	2	2	2	2	2	2	2
14	2.4	Drilling machine operator	ED+1	ED+11	4	4	4	4	4	4	4	4	4	4	4
15	2.5	Labour	ED+1	ED+3	12	12	12
16	2.6	Administrator	ED+1	ED+12	2	2	2	2	2	2	2	2	2	2	2	2
17		Sub-Total			23	23	23	9	9	9	9	9	7	6	6	2
18	3	Camp Installation Team
19	3.1	Site Manager	ED+10	ED+10										1
20	3.2	Construction Engineer	ED+10	ED+10										1
21	3.3	QHSE Engineer	ED+10	ED+10										1
22		Sub-Total			0	0	0	0	0	0	0	0	0	3	0	0
23		Grand Total			23	25	25	11	11	12	12	12	10	14	11	7
24
25
Manpower Plan

Attached Sheet2

Manpower Plan.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V
1	Well Pads Construction Manpower Plan				ED+ Month
2					1	2	3	4	5	6	7	8	9	10	11	12
3	No.	Category	Plan to Start	Plan to End
4	1	Project Management Team
5	1.1	Deputy Project Manager	ED+2	ED+12		1	1	1	1	1	1	1	1	1	1	1
6	1.2	Construction Manager	ED+10	ED+12										1	1	1
7	1.3	Site Manager	ED+6	ED+12	0	1	1	1	1	2	2	2	2	3	3	3
8		Sub-Total			0	2	2	2	2	3	3	3	3	5	5	5
9	2	Geotechnical Team
10	2.1	Team Leader	ED+1	ED+9	1	1	1	1	1	1	1	1	1
11	2.2	Geotechnical Engineer	ED+1	ED+3	2	2	2
12	2.3	Topographic Engineer	ED+1	ED+8	2	2	2	2	2	2	2	2
13	2.4	Drilling machine operator	ED+1	ED+11	4	4	4	4	4	4	4	4	4	4	4
14	2.5	Labour	ED+1	ED+3	12	12	12
15	2.6	Administrator	ED+1	ED+12	2	2	2	2	2	2	2	2	2	2	2	2
16		Sub-Total			23	23	23	9	9	9	9	9	7	6	6	2
17	3	Camp Installation Team
18	3.1	Site Manager	ED+10	ED+10										1
19	3.2	Construction Engineer	ED+10	ED+10										1
20	3.3	QHSE Engineer	ED+10	ED+10										1
21		Sub-Total			0	0	0	0	0	0	0	0	0	3	0	0
22		Grand Total			23	25	25	11	11	12	12	12	10	14	11	7
23
24
Manpower Plan

Cell Formulas
Range	Formula
E21:P21,E8:P8	E8	=SUBTOTAL(9,E5:E7)
E16:P16	E16	=SUBTOTAL(9,E10:E15)
E22:P22	E22	=SUBTOTAL(9,E5:E21)