Results 1 to 7 of 7

Thread: Creating a payroll weekley summary sheet

  1. #1
    Board Regular
    Join Date
    Oct 2014
    Posts
    331
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Creating a payroll weekley summary sheet

    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

  2. #2
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    4,473
    Post Thanks / Like
    Mentioned
    41 Post(s)
    Tagged
    12 Thread(s)

    Default Re: Creating a payroll weekley summary sheet

    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("Total")   'summary sheet
        days = Array("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat")
        cols = Array("B", "C", "D", "F", "G", "H", "AK", "AL")
        
        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
    Regards Dante Amor

  3. #3
    Board Regular
    Join Date
    Oct 2014
    Posts
    331
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Creating a payroll weekley summary sheet

    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

  4. #4
    Board Regular
    Join Date
    Oct 2014
    Posts
    331
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Creating a payroll weekley summary sheet

    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

    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

  5. #5
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    4,473
    Post Thanks / Like
    Mentioned
    41 Post(s)
    Tagged
    12 Thread(s)

    Default Re: Creating a payroll weekley summary sheet

    Quote Originally Posted by mingandmong View Post
    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

    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

    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 by DanteAmor; Jun 16th, 2019 at 09:10 AM.
    Regards Dante Amor

  6. #6
    Board Regular
    Join Date
    Oct 2014
    Posts
    331
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Creating a payroll weekley summary sheet

    Hi DanteAmor
    This new code has populated data from A3 down as my sheets have headers, this is working fine now
    Thankyou very much

  7. #7
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    4,473
    Post Thanks / Like
    Mentioned
    41 Post(s)
    Tagged
    12 Thread(s)

    Default Re: Creating a payroll weekley summary sheet

    Im glad to help you, thanks for the feedback.
    Regards Dante Amor

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •