Creating a payroll weekley summary sheet

mingandmong

Active Member
Joined
Oct 15, 2014
Messages
339
Hi I'm using excel 2016

i would like to create a weekly summary sheet totaling data from each daily worksheet, but only if they have worked during the week
So i have a workbook with tabs Sun-Sat the unique personnel number its in column A2 down (the unique number is not always in the same row on each sheet ie (A2 Sun but A20 on Mon)
i want to create the total sheet that automatically creates the personnel number in column A2 down but only once, and totals the data contained from column B,C,D,F,G,H,AK & AL

Thankyou very much
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Use this

Change data in red with your information.

Code:
Sub weekley_summary()
    Dim days As Variant, sh2 As Worksheet, sh1 As Worksheet, d As Variant
    Dim f As Range, cols As Variant, r As Long, i As Long, c As Variant
    
    Set sh1 = Sheets("[COLOR=#ff0000]Total[/COLOR]")   'summary sheet
    days = Array([COLOR=#ff0000]"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"[/COLOR])
    cols = Array([COLOR=#ff0000]"B", "C", "D", "F", "G", "H", "AK", "AL"[/COLOR])
    
    sh1.Rows("2:" & Rows.Count).ClearContents
    For Each d In days
        Set sh2 = Sheets(d)
        For i = 2 To sh2.Range("A" & Rows.Count).End(xlUp).Row
            Set f = sh1.Range("A:A").Find(sh2.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
            If Not f Is Nothing Then
                r = f.Row
            Else
                r = sh1.Range("A" & Rows.Count).End(xlUp).Row + 1
                sh1.Range("A" & r).Value = sh2.Cells(i, "A").Value
            End If
            For Each c In cols
                sh1.Cells(r, c).Value = sh1.Cells(r, c).Value + sh2.Cells(i, c).Value
            Next
        Next
    Next
    MsgBox "End"
End Sub
 
Upvote 0
Hell DanteAmor
Thankyou for taking the time to create a solution, i just need it tweaking as it is about there
I just have 3 small issues

1) i forgot to mention i have data headers, on each sheet so the actual data starts in A3 ( i did try changing the A to A3 but no result)
2) can the data extracted from AK & AL be placed in the Total sheet in column I & J as it populates into AK & AL i have just temp hide the columns to make it look nicer
3) Employees who do not work as this is a template have zeros pre-populated so the summary sheet is including these who do not work i do have a solution and that is to delete all rows that do not have a value in column AK ( blank cell)

And once again thank you very much its not easy interpreting somebody else's ideas when reading
 
Upvote 0
Hi
I have resloved the issue of deletion, as the macro below deletes all rows if column Al contains a zero this works, i just need's to delete from row 3 as my first 2 rows have headers

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub Macro2()
'Modified 2/4/2019 1:05:28 PM EST
Application.ScreenUpdating = False
Dim Counter As Long
With Range("AL3", Range("AL" & Rows.Count).End(xlUp))
.AutoFilter Field:=1, Criteria1:=Array("0"), Operator:=xlFilterValues
Counter = .Columns(AL).SpecialCells(xlCellTypeVisible).Count
If Counter > 1 Then
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End If
.AutoFilter
End With
Application.ScreenUpdating = True
End Sub[/FONT]
 
Upvote 0
Hi
I have resloved the issue of deletion, as the macro below deletes all rows if column Al contains a zero this works, i just need's to delete from row 3 as my first 2 rows have headers

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub Macro2()
'Modified 2/4/2019 1:05:28 PM EST
Application.ScreenUpdating = False
Dim Counter As Long
With Range("AL3", Range("AL" & Rows.Count).End(xlUp))
.AutoFilter Field:=1, Criteria1:=Array("0"), Operator:=xlFilterValues
Counter = .Columns(AL).SpecialCells(xlCellTypeVisible).Count
If Counter > 1 Then
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End If
.AutoFilter
End With
Application.ScreenUpdating = True
End Sub[/FONT]


Change 2 by 3:
Code:
sh1.Rows("3:" & Rows.Count).ClearContents
    For Each d In days
        Set sh2 = Sheets(d)
        For i = 3 To sh2.Range("A" & Rows.Count).End(xlUp).Row
 
Last edited:
Upvote 0
Hi DanteAmor
This new code has populated data from A3 down as my sheets have headers, this is working fine now
Thankyou very much
 
Upvote 0
Im glad to help you, thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,544
Messages
6,114,249
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top