Copy formulas down a summary page to individual time sheets

P

pbebow

New Member
Joined
Feb 15, 2021
Messages
15
Office Version
  1. 2013
Platform
  1. Windows
I keep track of payroll for my father in law's Care Workers, I have weekly time sheets set up for the whole year, then I have the summary page at the end (I've tried in the same workbook and a different workbook). The summary page references back to each weeks payroll to get the date and each person's weekly hours. I would like to be able to have each week automatically go to the correct worksheet without having to manually enter in everyone. I want to copy and paste it down the sheet and have it reference the correct worksheet, if that makes sense. Currently I type in =then click in the correct spot on the worksheet for that persons total hours and hit enter. But I have to do it for each employee every week and would prefer to have it automatically do it for me.

Screenshot payroll.png
 
Sort by date Sort by votes
pbebow said:
Sorry, you answered while I was asking again.... This worked!!! Yay!!!! Thank you so much!!!! This is awesome!!!
Click to expand...
I'm very glad to know that it worked :biggrin:
But one concern I have is that I didn't know you had prepared worksheets for the entire year.
When you run the macro, you got a bunch of messages asking if you'd like to output data onto sheet "Payroll" right?
The macro automatically sees if sheet "Payroll" has data with a date showing the end of a week and if there is for example a sheet named 3-Mar-21 but there's no data for the week ending on 3-Mar-21 on sheet "Payroll", it asks you if you'd like to add the relevant data to Payroll. So:

Capture.PNG


So, you'll want to delete sheets for future weeks for the macro to work properly.
I thus suggest making a copy of the newest worksheet every week and then running the macro. So:

Capture2.PNG



Capture3.PNG



Capture4.PNG



Capture5.PNG


Come back anytime if you get any further questions :biggrin:
 

Attachments

  • Capture5.PNG
    Capture5.PNG
    49.5 KB · Views: 5
Upvote 0

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
kanadaaa said:
I'm very glad to know that it worked :biggrin:
But one concern I have is that I didn't know you had prepared worksheets for the entire year.
When you run the macro, you got a bunch of messages asking if you'd like to output data onto sheet "Payroll" right?
The macro automatically sees if sheet "Payroll" has data with a date showing the end of a week and if there is for example a sheet named 3-Mar-21 but there's no data for the week ending on 3-Mar-21 on sheet "Payroll", it asks you if you'd like to add the relevant data to Payroll. So:

View attachment 32298

So, you'll want to delete sheets for future weeks for the macro to work properly.
I thus suggest making a copy of the newest worksheet every week and then running the macro. So:

View attachment 32302


View attachment 32303


View attachment 32304


View attachment 32307

Come back anytime if you get any further questions :biggrin:
Click to expand...
Hmm well that sucks! That was why I wanted this in the first place so I can just go in each week and record the hours and not have to create a worksheet or do the functions. I wanted it all automated. Because I have to have all of the worksheets done so that I can print them to give to them to keep track of their hours, so I would have to create them all then delete and then recreate and it's just a pain. I wanted to have all 52 timesheets for the year set up, with the payroll sheet at the end to calculate hours and pay weekly so that when I get the time sheet I can input the hours they worked, it'll automatically calculate thier total hours and then I can switch to the payroll sheet and the total pay per person and total will be automatically filled in and I print it and write the check... I guess I thought that is what your thing was so I did and now when I input the data into one of the empty timesheets it doesn't calculate into the payroll sheet... Guess I'm back to square one...
 
Upvote 0
That was one workaround but there's another also, which probably meets your demand.
I can modify the code so that it asks you if you'd like to proceed to the next week if there's more than one worksheet available for data output.
As long as one can rewrite a code, they can pursue its best.
Don't give up before asking if we can rewrite a code to make it as best as you can imagine.
When I have time, I'll try to incorporate a workaround into the code.
 
Upvote 0
Here.
VBA Code: 
Function IsInArray(valToBeFound As Variant, arr As Variant) As Boolean
    Dim element As Variant
    On Error GoTo IsInArrayError: 'array is empty
        For Each element In arr
            If element = valToBeFound Then
                IsInArray = True
                Exit Function
            End If
        Next element
Exit Function
IsInArrayError:
On Error GoTo 0
IsInArray = False
End Function
Function Cnv3LMonthToNum(cnvMonth As String) As String
    If cnvMonth = "Jan" Then
        Cnv3LMonthToNum = "01"
    ElseIf cnvMonth = "Feb" Then
        Cnv3LMonthToNum = "02"
    ElseIf cnvMonth = "Mar" Then
        Cnv3LMonthToNum = "03"
    ElseIf cnvMonth = "Apr" Then
        Cnv3LMonthToNum = "04"
    ElseIf cnvMonth = "May" Then
        Cnv3LMonthToNum = "05"
    ElseIf cnvMonth = "Jun" Then
        Cnv3LMonthToNum = "06"
    ElseIf cnvMonth = "Jul" Then
        Cnv3LMonthToNum = "07"
    ElseIf cnvMonth = "Aug" Then
        Cnv3LMonthToNum = "08"
    ElseIf cnvMonth = "Sep" Then
        Cnv3LMonthToNum = "09"
    ElseIf cnvMonth = "Oct" Then
        Cnv3LMonthToNum = "10"
    ElseIf cnvMonth = "Nov" Then
        Cnv3LMonthToNum = "11"
    ElseIf cnvMonth = "Dec" Then
        Cnv3LMonthToNum = "12"
    Else: Cnv3LMonthToNum = CVErr(xlErrNA)
    End If
End Function
Function IsArrayEmpty(arr As Variant) As Boolean
    On Error Resume Next
    IsArrayEmpty = True
    IsArrayEmpty = UBound(arr) < LBound(arr)
End Function
Sub Payroll()

    'Get emplyees' names
    Dim pr As Worksheet, wsCnt As Long, namesRow As Long, namesCnt As Long, iLoop As Long, i As Long, employees() As String, colors() As Long
    
    Set pr = Sheets("Payroll")
    wsCnt = ActiveWorkbook.Worksheets.Count - 2 'EDIT THIS NUMBER ACCORDING TO THE NUMBER OF SHEETS THAT START WITH AN ALPHABET
                                                                                'Now it's 2 because we have sheets named "Payroll" and "WagePerHour"
    namesRow = Sheets(wsCnt).Range("H" & Rows.Count).End(xlUp).Row
    namesCnt = (namesRow - 1) / 10
    iLoop = 0
    For i = 0 To namesCnt - 1
        ReDim Preserve employees(i)
        ReDim Preserve colors(i)
        employees(i) = Sheets(wsCnt).Range("A" & 2 + iLoop)
        colors(i) = Sheets(wsCnt).Range("A" & 2 + iLoop).Font.ColorIndex
        iLoop = iLoop + 10
    Next i
    '====Set employees()
    
    'Get weeks already on sheet "Payroll"
    Dim weeks() As String, fnd As Range, tempFnd As Range
    
    Set fnd = pr.Range("C:C").Find("*", pr.Range("C3"), xlValues)
    Set tempFnd = fnd
    i = 0
    Do While Not fnd Is Nothing
        ReDim Preserve weeks(i)
        If fnd <> "Week Ending" Then weeks(i) = fnd
        Set fnd = pr.Range("C:C").FindNext(fnd)
        If fnd.Address = tempFnd.Address Then
            Exit Do
        End If
        i = i + 1
    Loop
    '====Set weeks()
    
    'Get sheet names
    Dim shNames() As String, DBQ As String
    
    DBQ = """"
    For i = 0 To wsCnt - 1
        ReDim Preserve shNames(i)
        If Sheets(i + 1).Name <> "Payroll" Then
            shNames(i) = Sheets(i + 1).Name
            If Len(shNames(i)) = 8 Then
                shNames(i) = Cnv3LMonthToNum(Mid(shNames(i), 3, 3)) & "/" & "0" & Left(shNames(i), 1) & "/" & Right(shNames(i), 2)
            ElseIf Len(shNames(i)) = 9 Then
                shNames(i) = Cnv3LMonthToNum(Mid(shNames(i), 4, 3)) & "/" & Left(shNames(i), 2) & "/" & Right(shNames(i), 2)
            Else
                MsgBox "There are sheets that are not named in the form" & DBQ & "(d)d-Mmm-yy" & DBQ, vbExclamation, "Error"
                Exit Sub
            End If
        End If
    Next i
    '====Set shNames()
    
    'Get weeks not on sheet "Payroll"
    Dim nWeeks() As String, j As Long
    
    j = 0
    For i = LBound(shNames) To UBound(shNames)
        If IsInArray(shNames(i), weeks) = False Then
            ReDim Preserve nWeeks(j)
            nWeeks(j) = shNames(i)
            j = j + 1
        End If
    Next i
    '====Set nWeeks()
    
    If IsArrayEmpty(nWeeks) = True Then 'Show error message if there's no data to output to Payroll
        MsgBox "The sheet " & DBQ & "Payroll" & DBQ & " already has all the data available.", vbExclamation, "Error"
        Exit Sub
    End If
      
    'Output values into sheet "Payroll"
    Dim outputRow As Long, msg As Long, srcWs As Worksheet, fndWage As Range, wage As Single
        
    For i = LBound(nWeeks) To UBound(nWeeks)
        msg = MsgBox("Would you like to add data for the week ending:" & vbCrLf & vbCrLf & MonthName(Left(nWeeks(i), 2)) & " " _
            & Mid(nWeeks(i), 4, 2) & " 20" & Right(nWeeks(i), 2), vbYesNo, "Confirmation")
        If msg = vbYes Then
            Application.ScreenUpdating = False
            outputRow = pr.Range("A" & Rows.Count).End(xlUp).Row + 3
            If Val(Mid(nWeeks(i), 4, 2)) >= 10 Then
                Set srcWs = Sheets(Mid(nWeeks(i), 4, 2) & "-" & Left(MonthName(Left(nWeeks(i), 2)), 3) & "-" & Right(nWeeks(i), 2))
            Else
                Set srcWs = Sheets(Mid(nWeeks(i), 5, 1) & "-" & Left(MonthName(Left(nWeeks(i), 2)), 3) & "-" & Right(nWeeks(i), 2))
            End If
            For j = LBound(employees) To UBound(employees)
                Set fndWage = Sheets("WagePerHour").Range("2:3").Find(employees(j), , xlValues, xlWhole, xlByRows)
                If fndWage Is Nothing Then
                    MsgBox "Wage per hour for the following employee is not specified:" & vbCrLf & vbCrLf & employees(j), vbExclamation, "Error"
                    Exit Sub
                Else
                    wage = Sheets("WagePerHour").Range("A" & fndWage.Row)
                    pr.Range("A" & outputRow + j) = employees(j)
                    pr.Range("A" & outputRow + j).Font.ColorIndex = colors(j)
                    pr.Range("B" & outputRow + j) = srcWs.Range("H" & 10 * (j + 1) + 1) 'H11, H21, H31...
                    pr.Range("D" & outputRow + j) = "$" & Val(pr.Range("B" & outputRow + j)) * wage
                End If
            Next j
            pr.Range("C" & outputRow) = nWeeks(i)
            pr.Range("E" & outputRow) = "=SUM(D" & outputRow & ":" & "D" & outputRow + UBound(employees) & ")"
            pr.Range(Cells(outputRow, "A"), Cells(outputRow + UBound(employees), "E")).BorderAround Weight:=xlThin
            Application.ScreenUpdating = True
        End If
        If Not i = UBound(nWeeks) Then
            msg = MsgBox("There's more data available for output. Would you like to proceed to the next week?", vbYesNo, "Confirmation")
            If msg = vbNo Then
                Exit Sub
            End If
        End If
    Next i
    
End Sub
Delete all data for future weeks on sheet "Payroll" and give this a try.
You don't need those data for now right?
This time you'll just need to delete those data before running the macro. Not a drag.
 
Upvote 0
kanadaaa said:
Here.
VBA Code: 
Function IsInArray(valToBeFound As Variant, arr As Variant) As Boolean
    Dim element As Variant
    On Error GoTo IsInArrayError: 'array is empty
        For Each element In arr
            If element = valToBeFound Then
                IsInArray = True
                Exit Function
            End If
        Next element
Exit Function
IsInArrayError:
On Error GoTo 0
IsInArray = False
End Function
Function Cnv3LMonthToNum(cnvMonth As String) As String
    If cnvMonth = "Jan" Then
        Cnv3LMonthToNum = "01"
    ElseIf cnvMonth = "Feb" Then
        Cnv3LMonthToNum = "02"
    ElseIf cnvMonth = "Mar" Then
        Cnv3LMonthToNum = "03"
    ElseIf cnvMonth = "Apr" Then
        Cnv3LMonthToNum = "04"
    ElseIf cnvMonth = "May" Then
        Cnv3LMonthToNum = "05"
    ElseIf cnvMonth = "Jun" Then
        Cnv3LMonthToNum = "06"
    ElseIf cnvMonth = "Jul" Then
        Cnv3LMonthToNum = "07"
    ElseIf cnvMonth = "Aug" Then
        Cnv3LMonthToNum = "08"
    ElseIf cnvMonth = "Sep" Then
        Cnv3LMonthToNum = "09"
    ElseIf cnvMonth = "Oct" Then
        Cnv3LMonthToNum = "10"
    ElseIf cnvMonth = "Nov" Then
        Cnv3LMonthToNum = "11"
    ElseIf cnvMonth = "Dec" Then
        Cnv3LMonthToNum = "12"
    Else: Cnv3LMonthToNum = CVErr(xlErrNA)
    End If
End Function
Function IsArrayEmpty(arr As Variant) As Boolean
    On Error Resume Next
    IsArrayEmpty = True
    IsArrayEmpty = UBound(arr) < LBound(arr)
End Function
Sub Payroll()

    'Get emplyees' names
    Dim pr As Worksheet, wsCnt As Long, namesRow As Long, namesCnt As Long, iLoop As Long, i As Long, employees() As String, colors() As Long
   
    Set pr = Sheets("Payroll")
    wsCnt = ActiveWorkbook.Worksheets.Count - 2 'EDIT THIS NUMBER ACCORDING TO THE NUMBER OF SHEETS THAT START WITH AN ALPHABET
                                                                                'Now it's 2 because we have sheets named "Payroll" and "WagePerHour"
    namesRow = Sheets(wsCnt).Range("H" & Rows.Count).End(xlUp).Row
    namesCnt = (namesRow - 1) / 10
    iLoop = 0
    For i = 0 To namesCnt - 1
        ReDim Preserve employees(i)
        ReDim Preserve colors(i)
        employees(i) = Sheets(wsCnt).Range("A" & 2 + iLoop)
        colors(i) = Sheets(wsCnt).Range("A" & 2 + iLoop).Font.ColorIndex
        iLoop = iLoop + 10
    Next i
    '====Set employees()
   
    'Get weeks already on sheet "Payroll"
    Dim weeks() As String, fnd As Range, tempFnd As Range
   
    Set fnd = pr.Range("C:C").Find("*", pr.Range("C3"), xlValues)
    Set tempFnd = fnd
    i = 0
    Do While Not fnd Is Nothing
        ReDim Preserve weeks(i)
        If fnd <> "Week Ending" Then weeks(i) = fnd
        Set fnd = pr.Range("C:C").FindNext(fnd)
        If fnd.Address = tempFnd.Address Then
            Exit Do
        End If
        i = i + 1
    Loop
    '====Set weeks()
   
    'Get sheet names
    Dim shNames() As String, DBQ As String
   
    DBQ = """"
    For i = 0 To wsCnt - 1
        ReDim Preserve shNames(i)
        If Sheets(i + 1).Name <> "Payroll" Then
            shNames(i) = Sheets(i + 1).Name
            If Len(shNames(i)) = 8 Then
                shNames(i) = Cnv3LMonthToNum(Mid(shNames(i), 3, 3)) & "/" & "0" & Left(shNames(i), 1) & "/" & Right(shNames(i), 2)
            ElseIf Len(shNames(i)) = 9 Then
                shNames(i) = Cnv3LMonthToNum(Mid(shNames(i), 4, 3)) & "/" & Left(shNames(i), 2) & "/" & Right(shNames(i), 2)
            Else
                MsgBox "There are sheets that are not named in the form" & DBQ & "(d)d-Mmm-yy" & DBQ, vbExclamation, "Error"
                Exit Sub
            End If
        End If
    Next i
    '====Set shNames()
   
    'Get weeks not on sheet "Payroll"
    Dim nWeeks() As String, j As Long
   
    j = 0
    For i = LBound(shNames) To UBound(shNames)
        If IsInArray(shNames(i), weeks) = False Then
            ReDim Preserve nWeeks(j)
            nWeeks(j) = shNames(i)
            j = j + 1
        End If
    Next i
    '====Set nWeeks()
   
    If IsArrayEmpty(nWeeks) = True Then 'Show error message if there's no data to output to Payroll
        MsgBox "The sheet " & DBQ & "Payroll" & DBQ & " already has all the data available.", vbExclamation, "Error"
        Exit Sub
    End If
     
    'Output values into sheet "Payroll"
    Dim outputRow As Long, msg As Long, srcWs As Worksheet, fndWage As Range, wage As Single
       
    For i = LBound(nWeeks) To UBound(nWeeks)
        msg = MsgBox("Would you like to add data for the week ending:" & vbCrLf & vbCrLf & MonthName(Left(nWeeks(i), 2)) & " " _
            & Mid(nWeeks(i), 4, 2) & " 20" & Right(nWeeks(i), 2), vbYesNo, "Confirmation")
        If msg = vbYes Then
            Application.ScreenUpdating = False
            outputRow = pr.Range("A" & Rows.Count).End(xlUp).Row + 3
            If Val(Mid(nWeeks(i), 4, 2)) >= 10 Then
                Set srcWs = Sheets(Mid(nWeeks(i), 4, 2) & "-" & Left(MonthName(Left(nWeeks(i), 2)), 3) & "-" & Right(nWeeks(i), 2))
            Else
                Set srcWs = Sheets(Mid(nWeeks(i), 5, 1) & "-" & Left(MonthName(Left(nWeeks(i), 2)), 3) & "-" & Right(nWeeks(i), 2))
            End If
            For j = LBound(employees) To UBound(employees)
                Set fndWage = Sheets("WagePerHour").Range("2:3").Find(employees(j), , xlValues, xlWhole, xlByRows)
                If fndWage Is Nothing Then
                    MsgBox "Wage per hour for the following employee is not specified:" & vbCrLf & vbCrLf & employees(j), vbExclamation, "Error"
                    Exit Sub
                Else
                    wage = Sheets("WagePerHour").Range("A" & fndWage.Row)
                    pr.Range("A" & outputRow + j) = employees(j)
                    pr.Range("A" & outputRow + j).Font.ColorIndex = colors(j)
                    pr.Range("B" & outputRow + j) = srcWs.Range("H" & 10 * (j + 1) + 1) 'H11, H21, H31...
                    pr.Range("D" & outputRow + j) = "$" & Val(pr.Range("B" & outputRow + j)) * wage
                End If
            Next j
            pr.Range("C" & outputRow) = nWeeks(i)
            pr.Range("E" & outputRow) = "=SUM(D" & outputRow & ":" & "D" & outputRow + UBound(employees) & ")"
            pr.Range(Cells(outputRow, "A"), Cells(outputRow + UBound(employees), "E")).BorderAround Weight:=xlThin
            Application.ScreenUpdating = True
        End If
        If Not i = UBound(nWeeks) Then
            msg = MsgBox("There's more data available for output. Would you like to proceed to the next week?", vbYesNo, "Confirmation")
            If msg = vbNo Then
                Exit Sub
            End If
        End If
    Next i
   
End Sub
Delete all data for future weeks on sheet "Payroll" and give this a try.
You don't need those data for now right?
This time you'll just need to delete those data before running the macro. Not a drag.
Click to expand...
Well I tried that but it doesn't work. I deleted all future weeks on the payroll page like you instructed. I added the new code that you showed... Ran run macro. I then tried entering data into the next week and nothing happened so I did run macro again and an error came up...
error.png
 
Upvote 0
pbebow said:
Well I tried that but it doesn't work. I deleted all future weeks on the payroll page like you instructed. I added the new code that you showed... Ran run macro. I then tried entering data into the next week and nothing happened so I did run macro again and an error came up...
View attachment 32473
Click to expand...
Run the macro again with the code tab open.
I need to know which line is causing the error then, so let me know which line is highlighted.
 
Upvote 0
pbebow said:
View attachment 32474
Click to expand...
No, that's not the code I wrote for you.
You must have accidentally hit "Record Macro" on the developer tab.
Go to the developer tab and if you see "Stop recording" in the Code section in the ribbon, press it (you can erase the code named "Macro 1" altogether).
I need you to see if macro "Payroll" runs properly without an error.
If it doesn't, the code stops running and shows where it's going through an error by highlighting a line.
 
Upvote 0
kanadaaa said:
No, that's not the code I wrote for you.
You must have accidentally hit "Record Macro" on the developer tab.
Go to the developer tab and if you see "Stop recording" in the Code section in the ribbon, press it (you can erase the code named "Macro 1" altogether).
I need you to see if macro "Payroll" runs properly without an error.
If it doesn't, the code stops running and shows where it's going through an error by highlighting a line.
Click to expand...
Ok so am I supposed to save this last code over the first one we did that didn't work? I'm just not exactly sure of the steps... I went to developer, macros, clicked on payroll and edit and then deleted what was there and added the new one but then it pops up a second code box and they both look the same but when I run the macro it does the same as the first time, asking before everything.
 
Upvote 0
pbebow said:
Ok so am I supposed to save this last code over the first one we did that didn't work? I'm just not exactly sure of the steps... I went to developer, macros, clicked on payroll and edit and then deleted what was there and added the new one but then it pops up a second code box and they both look the same but when I run the macro it does the same as the first time, asking before everything.
Click to expand...
kanadaaa said:
No, that's not the code I wrote for you.
You must have accidentally hit "Record Macro" on the developer tab.
Go to the developer tab and if you see "Stop recording" in the Code section in the ribbon, press it (you can erase the code named "Macro 1" altogether).
I need you to see if macro "Payroll" runs properly without an error.
If it doesn't, the code stops running and shows where it's going through an error by highlighting a line.
Click to expand...
I have tried several times to delete the original code and replace it with this new one and it just does the same thing over as the first code.
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
Help with VBA code to copy/paste into another workbook then email
Replies
1
Views
225
bh24524
B
G
  • Question
Summary Sheet lookup
2
Replies
16
Views
205
awoohaw
awoohaw
E
  • Solved
Large Spreadsheet Help!
Replies
5
Views
195
awoohaw
awoohaw
H
  • Solved
How to copy data from one file and paste it into a dynamically named workbook
Replies
3
Views
149
dermie_72
D
K
  • Solved
Reference Worksheet in Formula
Replies
2
Views
136
Kaloyanides
K

Forum statistics

Threads
1,214,431
Messages
6,119,462
Members
448,899
Latest member
maplemeadows

Share this page

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