Creating a YTD Sheet that sums all weeklyresults from weekly sheets, but Employee row is not static.

tennesyl

New Member
Joined
Jun 22, 2012
Messages
3
I'm sure the answer to this is in another thread, but I searched for a good while with no luck.

I have a workbook that contains a worksheet for every week of the year. There is also a sheet for Year to Date. On each sheet there is a list of the employees. (A5-A25 or so)

This is what the weekly sheet looks like.
Emplyee Last NameEmployee First NameMTWThFWeekly Total
Last Name 1First Name 1111216
Last Name 2First Name 2211127
Last Name 3First Name 3111115
Last Name 4First Name 4122218
Weekly Total26

<TBODY>
</TBODY>


The YTD sheet would be identical, except for each day of the week, it would be the total for the year.

Typically this would be a simple summation across sheets. Unfortunately, since our department has some turn-over in staffing, Employee 1 might be on row 5 for most weeks, but he might be on row 4 on another week. If more people get hired, he might get moved down to Row 6 for other weeks.

Since the employee's row is not static, I need to figure out how to do some sort of look-up or cross referencing that I'm not versed in.

In simple terms, the logic is : Total all of the Monday calls, for each employee, on their own row regardless of what row they happen to be on that week.

I was researching earlier, and it looks like I will need a table that contains all of the tabs (sheet) names, so that has already been created. It is located on the side of the YTD sheet, and it's called 'tabnames'.

Help! And of course, Thanks!!!
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
The attached code will sumarize all "TimeSheet" worksheets in the Workbook and place the results a sheets called "YTD". The YTD sheet must exist for the the code to work.

Here is the code:

Code:
Option Explicit
Type TypeRec
    name As String
    Day(4) As Long
End Type

Sub ProcessYTD()
    Const YTDSheetName As String = "YTD"
    Dim Wb As Workbook
    Dim Ws As Worksheet
    
    Dim WsYTD As Worksheet
    
    Dim SheetNo As Integer
    Dim RowNo As Long
    Dim Rec() As TypeRec
    Dim IDX As Long
    Dim lngDay As Long
    Dim strName As String
    Dim arrName As Variant
    
    ReDim Rec(0)
    
    Set Wb = ThisWorkbook
    Set WsYTD = Wb.Sheets(YTDSheetName)
    For SheetNo = 1 To Wb.Sheets.Count
        If Wb.Sheets(SheetNo).name <> YTDSheetName Then
            Set Ws = Wb.Sheets(SheetNo)
            For RowNo = 2 To Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row - 1
                strName = Trim(Ws.Cells(RowNo, "A")) & "~" & Trim(Ws.Cells(RowNo, "B"))
                IDX = FindIdx(Rec, strName)
                For lngDay = 0 To 4
                    Rec(IDX).Day(lngDay) = Rec(IDX).Day(lngDay) + Val(Ws.Cells(RowNo, 3 + lngDay))
                Next lngDay
            Next RowNo
        End If
    Next SheetNo
    
    WsYTD.Cells.ClearContents
    WsYTD.Cells(1, "A") = "Last Name"
    WsYTD.Cells(1, "B") = "First Name"
    WsYTD.Cells(1, "C") = "M"
    WsYTD.Cells(1, "d") = "T"
    WsYTD.Cells(1, "E") = "W"
    WsYTD.Cells(1, "F") = "Th"
    WsYTD.Cells(1, "G") = "F"
    
    For IDX = 1 To UBound(Rec)
        arrName = Split(Rec(IDX).name, "~")
        WsYTD.Cells(IDX + 1, "A") = arrName(0)
        WsYTD.Cells(IDX + 1, "B") = arrName(1)
        
        For lngDay = 0 To 4
            WsYTD.Cells(IDX + 1, 3 + lngDay) = Rec(IDX).Day(lngDay)
        Next lngDay
    Next IDX
    WsYTD.Activate
    
    MsgBox "Complete", vbInformation
End Sub

Function FindIdx(Rec() As TypeRec, ByVal strName As String) As Long
    Dim IDX As Long
    For IDX = 1 To UBound(Rec)
        If strName = Rec(IDX).name Then
            FindIdx = IDX
            Exit Function
        End If
    Next IDX
    
    ReDim Preserve Rec(IDX)
    Rec(IDX).name = strName
    FindIdx = IDX
End Function

Currently, the Header and Totals are not incuded. If the above code work for you, I will get the headers and weekly totals working as well
 
Last edited:
Upvote 0
Thanks for the help!

I used the code and it pulled most of the data, but due to some of my formatting, I had to make some tweaks.

I took out the line that says 'clearcontents.'
I changed a few lines where I saw 'IDX + 1' etc. That moved the results around on the YTD page.

I created Weekly totals and Daily totals on the YTD page.

This was very helpful and I'm sure I will post again when I need some help. Thanks so much!
 
Upvote 0
PS. This is the Code I am now using, based on your code with just a few tweaks.

Sub ProcessYTD()
Const YTDSheetName As String = "YTD"
Dim Wb As Workbook
Dim Ws As Worksheet

Dim WsYTD As Worksheet

Dim SheetNo As Integer
Dim RowNo As Long
Dim Rec() As TypeRec
Dim IDX As Long
Dim lngDay As Long
Dim strName As String
Dim arrName As Variant

ReDim Rec(0)

Set Wb = ThisWorkbook
Set WsYTD = Wb.Sheets(YTDSheetName)
For SheetNo = 1 To Wb.Sheets.Count
If Wb.Sheets(SheetNo).name <> YTDSheetName Then
Set Ws = Wb.Sheets(SheetNo)
For RowNo = 5 To Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row - 1
strName = Trim(Ws.Cells(RowNo, "A")) & "~" & Trim(Ws.Cells(RowNo, "B"))
IDX = FindIdx(Rec, strName)
For lngDay = 0 To 4
Rec(IDX).Day(lngDay) = Rec(IDX).Day(lngDay) + Val(Ws.Cells(RowNo, 4 + lngDay))
Next lngDay
Next RowNo
End If
Next SheetNo


WsYTD.Cells(4, "A") = "Last Name"
WsYTD.Cells(4, "B") = "First Name"
WsYTD.Cells(4, "d") = "M"
WsYTD.Cells(4, "e") = "T"
WsYTD.Cells(4, "f") = "W"
WsYTD.Cells(4, "g") = "Th"
WsYTD.Cells(4, "h") = "F"
WsYTD.Cells(1, "D") = "SPT-Support Email Tracker YTD 2012"

For IDX = 4 To UBound(Rec)
arrName = Split(Rec(IDX).name, "~")
WsYTD.Cells(IDX + 1, "A") = arrName(0)
WsYTD.Cells(IDX + 1, "B") = arrName(1)

For lngDay = 0 To 4
WsYTD.Cells(IDX + 1, 4 + lngDay) = Rec(IDX).Day(lngDay)
Next lngDay
Next IDX
WsYTD.Activate

MsgBox "Complete", vbInformation
End Sub
Function FindIdx(Rec() As TypeRec, ByVal strName As String) As Long
Dim IDX As Long
For IDX = 4 To UBound(Rec)
If strName = Rec(IDX).name Then
FindIdx = IDX
Exit Function
End If
Next IDX

ReDim Preserve Rec(IDX)
Rec(IDX).name = strName
FindIdx = IDX
End Function



Thanks, Again
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,952
Members
448,535
Latest member
alrossman

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