Total a column and repeat headings

[marcidee]

Please can someone help me with a script - I have a sheet that has a blank row every time a new name appears in column A

What i would like is to:

Place a total of the figures in column G - total in column F (last row)
Repeat the headings from row 1 on each blank line

Example of end result below

Thank you for your help

Name	Timesheet	P/E Date	Company	Time worked	Pay Rate	Total Pay
						0
Abimbola Dunsin (Dunsin) B	1	Thu 08 Aug 2019	Peter Howes	0.75	9.00	6.75
Abimbola Dunsin (Dunsin) B	1	Fri 09 Aug 2019	Peter Howes	0.5	9.00	4.5
Abimbola Dunsin (Dunsin) B	1	Sat 10 Aug 2019	Phillip Mercer	0.25	9.00	2.25	13.5
Name	Timesheet	P/E Date	Company	Time worked	Pay Rate	Total Pay
Afaque Solangi	1	Mon 12 Aug 2019	Mohsen Taheri	7	9.00	63
Afaque Solangi	1	Tue 13 Aug 2019	Mohsen Taheri	7	9.00	63
Afaque Solangi	1	Wed 14 Aug 2019	Mohsen Taheri	7	9.00	63	189
Name	Timesheet	P/E Date	Company	Time worked	Pay Rate	Total Pay
Amalia Gatou B	1	Thu 15 Aug 2019	Amanda King	1	9.00	9
Amalia Gatou B	1	Fri 16 Aug 2019	Amanda King	0.25	9.00	2.25
Amalia Gatou B	1	Sat 17 Aug 2019	Amanda King	0.25	9.00	2.25	13.5

<tbody>
</tbody>

I had posted this question on another forum however I did not find a solution - the link to this question is below:

https://www.ozgrid.com/forum/forum/h...es-in-column-a

The first part of the link is irrelevant as I have been fortunate to be given the solution in this forum by -'fluff' however I am looking for a solution to this question as I require both methods

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG13Aug32
[COLOR="Navy"]Dim[/COLOR] R [COLOR="Navy"]As[/COLOR] Range, lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
lst = Range("A" & Rows.Count).End(xlUp).Row
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Range("G:G").SpecialCells(xlCellTypeConstants).Areas
    R(R.Count).Offset(, 1) = Application.Sum(R)
    [COLOR="Navy"]If[/COLOR] R(R.Count).Offset(, 1).Row < lst [COLOR="Navy"]Then[/COLOR]
        Range("A1:G1").Copy R(R.Count).Offset(1, -6)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[marcidee]

That works, perfect - your help is very much appreciated.

Thank you

 

[MickG]

You're welcome

 

[marcidee]

I am now having a problem to get the last part of the solution that you gave me last night working (total in column F and repeating first line) this were working fine - the sheet I was working on has changed slightly - but the only difference I can see is that column D contains no data (I left it like this so Column G remained as G. When running the script it is now not adding the headings or the totals?

I now see the below after running the script

Name	P/E Date	Client		Time Worked	Pay Rate	Total Pay	0
Name	P/E Date	Client		Time Worked	Pay Rate	Total Pay
Abimbola Dunsin (Dunsin) B	Fri 02 Aug 2019	Constance Rubidge		0.75	9.00	6.75
Abimbola Dunsin (Dunsin) B	Sat 03 Aug 2019	Constance Rubidge		0.25	9.00	2.25
Abimbola Dunsin (Dunsin) B	Sat 10 Aug 2019	Sheila Rice		0.75	9.00	6.75
Abimbola Dunsin (Dunsin) B	Sun 11 Aug 2019	Theresa Darling		0.25	9.00	2.25
Afaque Solangi	Mon 12 Aug 2019	Mohsen Taheri		7	9.00	63.00
Afaque Solangi	Tue 13 Aug 2019	Mohsen Taheri		7	9.00	63.00
Afaque Solangi	Wed 14 Aug 2019	Mohsen Taheri		7	9.00	63.00
Amalia Gatou B	Thu 15 Aug 2019	Amanda King		1	9.00	9.00
Amalia Gatou B	Fri 16 Aug 2019	Amanda King		0.25	9.00	2.25
Amalia Gatou B	Sat 17 Aug 2019	Amanda King		0.25	9.00	2.25

<colgroup><col><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>

 

[MickG]

The code works based on the Blank rows , which is what you had in the first instance.
When you run the code the Header in row 1 are added to each blank row and also the totals for each set of data
Once you have run the code, those blank rows are filled with the header and running the code again will not do anything.
I noticed on your previous data there was a "0" in cell "G2", this "0" stopped the otherwise blank row 2 from also filling with the headers.
In the current data, Row 2 have now got headers in it and "H1" seems to have a "0" I think that is because after originally running the code, you removed the previous "0" in "G2" and ran the code again, resulting in what you have now.

NB:- Data Column "D" data should make no difference to the code.
To Run the code again to get a result, you will need to remove the headers Rows where they where previous filled, when the code was first run, and then run the code again.
Good Luck
Regrds Mick

 

[marcidee]

The sheet looks like the below before I am running the script and this is the script I am using

Option Explicit
Sub RunAlladdblank()
Call AddBlankRows
Call MG13Aug32

End Sub






Sub AddBlankRows()
'
Dim iRow As Integer, iCol As Integer
Dim oRng As Range


Set oRng = Range("a1")


iRow = oRng.Row
iCol = oRng.Column


Do
'
If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
Cells(iRow + 1, iCol).EntireRow.Insert Shift:=xlDown
iRow = iRow + 2
Else
iRow = iRow + 1
End If
'
Loop While Not Cells(iRow, iCol).Text = ""
'
End Sub






Sub MG13Aug32()
Dim R As Range, lst As Long
lst = Range("A" & Rows.Count).End(xlUp).Row
For Each R In Range("G:G").SpecialCells(xlCellTypeConstants).Areas
R(R.Count).Offset(, 1) = Application.Sum(R)
If R(R.Count).Offset(, 1).Row < lst Then
Range("A1:G1").Copy R(R.Count).Offset(1, -6)
End If
Next R
End Sub

Name	Timesheet	P/E Date	Client	Time Worked	Pay Rate	Total Pay
Abimbola Dunsin (Dunsin) B	1	Fri 02 Aug 2019	Constance Rubidge	0.75	9.00	6.75
Abimbola Dunsin (Dunsin) B	1	Fri 02 Aug 2019	Constance Rubidge	0.25	9.00	2.25
Abimbola Dunsin (Dunsin) B	1	Fri 02 Aug 2019	Isobella Clark,	0.5	9.00	4.50
Afaque Solangi	1	Mon 29 Jul 2019	Mohsen Taheri	7	9.00	63.00
Afaque Solangi	1	Wed 31 Jul 2019	Mohsen Taheri	7	9.00	63.00
Afaque Solangi	1	Fri 02 Aug 2019	Mohsen Taheri	7	9.00	63.00
Amalia Gatou B	1	Wed 31 Jul 2019	Amanda King	1	9.00	9.00
Amalia Gatou B	1	Wed 31 Jul 2019	Amanda King	0.25	9.00	2.25
Ana Sofia Alves De Almieda (Sofia) Team Leader	1	Mon 29 Jul 2019	Beryl Jospehine	0.75	9.00	6.75
Ana Sofia Alves De Almieda (Sofia) Team Leader	1	Mon 29 Jul 2019	Beryl Jospehine	0.5	9.00	4.50
Ana Sofia Alves De Almieda (Sofia) Team Leader	1	Mon 29 Jul 2019	Isobella Clark,	0.5	9.00	4.50

<colgroup><col span="2"><col span="2"><col span="3"></colgroup><tbody>
</tbody>

 

[MickG]

That seems to work OK for me except it places a Extra header in rows 2.
if you change :- iRow = 2 That should stop that!!

 

[marcidee]

I am at a loss as it doesn't work on mine?

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG14Aug44
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] Range
Lst = Range("A" & Rows.Count).End(xlUp).Row

[COLOR="Navy"]For[/COLOR] n = Lst To 3 [COLOR="Navy"]Step[/COLOR] -1
    [COLOR="Navy"]If[/COLOR] Cells(n, 1) <> Cells(n - 1, 1) [COLOR="Navy"]Then[/COLOR]
        Cells(n, 1).EntireRow.Insert shift:=xlDown
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n

Lst = Range("A" & Rows.Count).End(xlUp).Row
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Range("G:G").SpecialCells(xlCellTypeConstants).Areas
        R(R.Count).Offset(, 1) = Application.Sum(R)
        [COLOR="Navy"]If[/COLOR] R(R.Count).Offset(, 1).Row < Lst [COLOR="Navy"]Then[/COLOR]
            Range("A1:G1").Copy R(R.Count).Offset(1, -6)
        [COLOR="Navy"]End[/COLOR] If
  [COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick