# Data separated by weeks-Macros welcomed and preferred

#### i8ur4re

##### Board Regular
Hi,

I have an excel sheet that has over 34,000 rows. It has the employees name, payroll date, and time card hours.

Example:

Payroll Name File Number Payroll Pay Date Timecard Hours

John Smith 0012345 07/26/2018 8.00
John Smith 0012345 07/27/2018 8.00
John Smith 0012345 08/02/2018 8.00
John Smith 0012345 08/03/2018 7.50
John Smith 0012345 08/09/2018 8.30
John Smith 0012345 08/10/2018 8.40
John Smith 0012345 08/11/2018 6.60​

This employee is one out of 200, the "Payroll Pay Date" continues to today's date. What I am trying to accomplish is this, for every work week, starting on Monday and ending on Sunday, I would like to calculate that persons hours for that specific week.

So for John Smith, he worked on 07/26/2018 and 07/27/2018, that would be his total hours for the week. His next set of hours for the week would be for 08/02/2018 and 08/03/2018.

I hope that makes sense. All in all, I am trying to break down this excel sheet to show weekly hours worked for each employee, with 34,000 rows.

### Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

#### MickG

##### MrExcel MVP
Try this:-
The code assumes the "Payroll Names" start "A2" there are 4 columns of data and the results start "A1" sheet2.
Code:
``````[COLOR="Navy"]Sub[/COLOR] MG14Mar07
[COLOR="Navy"]Dim[/COLOR] n       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng     [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Ray     [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Dic     [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Q       [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Wnum    [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

Ray = Range("A1").CurrentRegion
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = 1

[COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
Wnum = Application.WeekNum(Ray(n, 3))
[COLOR="Navy"]If[/COLOR] Not Dic.exists(Ray(n, 2)) [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Set[/COLOR] Dic(Ray(n, 2)) = CreateObject("Scripting.Dictionary")
[COLOR="Navy"]End[/COLOR] If

[COLOR="Navy"]If[/COLOR] Not Dic(Ray(n, 2)).exists(Wnum) [COLOR="Navy"]Then[/COLOR]
Dic(Ray(n, 2)).Add (Wnum), Array(Ray(n, 1), Ray(n, 4))
[COLOR="Navy"]Else[/COLOR]
Q = Dic(Ray(n, 2)).Item(Wnum)
Q(1) = Q(1) + Ray(n, 4)
Dic(Ray(n, 2)).Item(Wnum) = Q
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Dim[/COLOR] k        [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] p        [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c        [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

ReDim nray(1 To UBound(Ray, 1), 1 To 4)
c = 1
nray(1, 1) = "Payroll Name": nray(1, 2) = "File Number"
nray(1, 3) = "Week Num": nray(1, 4) = "Timecard Hours"

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
c = c + 1
nray(c, 1) = Dic(k).Item(p)(0)
nray(c, 2) = k
nray(c, 3) = p
nray(c, 4) = Dic(k).Item(p)(1)
[COLOR="Navy"]Next[/COLOR] p
[COLOR="Navy"]Next[/COLOR] k

[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 4)
.Value = nray
.Borders.Weight = 2
.Columns.AutoFit
.HorizontalAlignment = xlCenter
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]``````
Regards Mick

Last edited:

#### i8ur4re

##### Board Regular
Try this:-
The code assumes the "Payroll Names" start "A2" there are 4 columns of data and the results start "A1" sheet2.
Code:
``````[COLOR=Navy]Sub[/COLOR] MG14Mar07
[COLOR=Navy]Dim[/COLOR] n       [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Rng     [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Ray     [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Dic     [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Dim[/COLOR] Q       [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Wnum    [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]

Ray = Range("A1").CurrentRegion
[COLOR=Navy]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = 1

[COLOR=Navy]For[/COLOR] n = 2 To UBound(Ray, 1)
Wnum = Application.WeekNum(Ray(n, 3))
[COLOR=Navy]If[/COLOR] Not Dic.exists(Ray(n, 2)) [COLOR=Navy]Then[/COLOR]
[COLOR=Navy]Set[/COLOR] Dic(Ray(n, 2)) = CreateObject("Scripting.Dictionary")
[COLOR=Navy]End[/COLOR] If

[COLOR=Navy]If[/COLOR] Not Dic(Ray(n, 2)).exists(Wnum) [COLOR=Navy]Then[/COLOR]
Dic(Ray(n, 2)).Add (Wnum), Array(Ray(n, 1), Ray(n, 4))
[COLOR=Navy]Else[/COLOR]
Q = Dic(Ray(n, 2)).Item(Wnum)
Q(1) = Q(1) + Ray(n, 4)
Dic(Ray(n, 2)).Item(Wnum) = Q
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] n
[COLOR=Navy]Dim[/COLOR] k        [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] p        [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] c        [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]

ReDim nray(1 To UBound(Ray, 1), 1 To 4)
c = 1
nray(1, 1) = "Payroll Name": nray(1, 2) = "File Number"
nray(1, 3) = "Week Num": nray(1, 4) = "Timecard Hours"

[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] k [COLOR=Navy]In[/COLOR] Dic.Keys
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] p [COLOR=Navy]In[/COLOR] Dic(k)
c = c + 1
nray(c, 1) = Dic(k).Item(p)(0)
nray(c, 2) = k
nray(c, 3) = p
nray(c, 4) = Dic(k).Item(p)(1)
[COLOR=Navy]Next[/COLOR] p
[COLOR=Navy]Next[/COLOR] k

[COLOR=Navy]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 4)
.Value = nray
.Borders.Weight = 2
.Columns.AutoFit
.HorizontalAlignment = xlCenter
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]``````
Regards Mick

Thank you so much Mick, that did it, I just have one question, I do have 2 column that i did not put in my example, first one is in column A and the other one is in column E. What do i need to change to take those columns into consideration, its repetitive data, so i didnt think it was required in the example.

#### MickG

##### MrExcel MVP
So with new data in column "A". The data you sent would now start in column "B" with column "TimeCard Hours" now being in column "E", But you now say you have other data in column "E" , so what column is the "TimeCard Hours" data.

Perhaps a Header example would show the column Layout. !!

#### i8ur4re

##### Board Regular

So with new data in column "A". The data you sent would now start in column "B" with column "TimeCard Hours" now being in column "E", But you now say you have other data in column "E" , so what column is the "TimeCard Hours" data.

Perhaps a Header example would show the column Layout. !!

Hi Mick, sorry about that, below is what the header looks like:

A=Payroll Company
B=Code Payroll Name
C=File Number
D=Payroll Pay Date
E=Timecard Hours
F=Paycode

the Timecard hours is in column E. Anyway I can add a boarder around each payroll name, maybe a shade of white and blue formatting just so i can distinguish easily which Name and hours belong to that person?

Thank you very much in advance.

Last edited:

#### MickG

##### MrExcel MVP
Try this , Results sheet2
Code:
``````[COLOR="Navy"]Sub[/COLOR] MG15Mar48
[COLOR="Navy"]Dim[/COLOR] n       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng     [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Ray     [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Dic     [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Q       [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Wnum    [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

Ray = Range("A1").CurrentRegion
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = 1

[COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
Wnum = Application.WeekNum(Ray(n, 4))
[COLOR="Navy"]If[/COLOR] Not Dic.exists(Ray(n, 3)) [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Set[/COLOR] Dic(Ray(n, 3)) = CreateObject("Scripting.Dictionary")
[COLOR="Navy"]End[/COLOR] If

[COLOR="Navy"]If[/COLOR] Not Dic(Ray(n, 3)).exists(Wnum) [COLOR="Navy"]Then[/COLOR]
Dic(Ray(n, 3)).Add (Wnum), Array(Ray(n, 2), Ray(n, 5))
[COLOR="Navy"]Else[/COLOR]
Q = Dic(Ray(n, 3)).Item(Wnum)
Q(1) = Q(1) + Ray(n, 5)
Dic(Ray(n, 3)).Item(Wnum) = Q
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Dim[/COLOR] k        [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] p        [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c        [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

ReDim nray(1 To UBound(Ray, 1), 1 To 4)
c = 1
nray(1, 1) = "Payroll Name": nray(1, 2) = "File Number"
nray(1, 3) = "Week Num": nray(1, 4) = "Timecard Hours"

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
c = c + 1
nray(c, 1) = Dic(k).Item(p)(0)
nray(c, 2) = k
nray(c, 3) = p
nray(c, 4) = Dic(k).Item(p)(1)
[COLOR="Navy"]Next[/COLOR] p
[COLOR="Navy"]Next[/COLOR] k

[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 4)
.Value = nray
.Borders.Weight = 2
.Columns.AutoFit
.HorizontalAlignment = xlCenter
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]``````
Regards Mick

#### i8ur4re

##### Board Regular

Hi MickG,

So I have been using the code you provided, im just having some issues that maybe you can help me out with.

 XWT Mary J 008126 01/01/2018 5.2 REGULAR XWT Mary J 008126 01/02/2018 8.2 REGULAR XWT Mary J 008126 01/03/2018 7.5 REGULAR XWT Mary J 008126 01/04/2018 8 REGULAR XWT Mary J 008126 01/07/2018 8.3 REGULAR

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

She worked according to the hours in her time slot a total of 37.2 hours from 01/01/2018 til 01/07/2019.

The code calculated it as 28.9 hours.

Any idea where i can make edits to the code to fix this?

Try this , Results sheet2
Code:
``````[COLOR=Navy]Sub[/COLOR] MG15Mar48
[COLOR=Navy]Dim[/COLOR] n       [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Rng     [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Ray     [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Dic     [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Dim[/COLOR] Q       [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Wnum    [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]

Ray = Range("A1").CurrentRegion
[COLOR=Navy]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = 1

[COLOR=Navy]For[/COLOR] n = 2 To UBound(Ray, 1)
Wnum = Application.WeekNum(Ray(n, 4))
[COLOR=Navy]If[/COLOR] Not Dic.exists(Ray(n, 3)) [COLOR=Navy]Then[/COLOR]
[COLOR=Navy]Set[/COLOR] Dic(Ray(n, 3)) = CreateObject("Scripting.Dictionary")
[COLOR=Navy]End[/COLOR] If

[COLOR=Navy]If[/COLOR] Not Dic(Ray(n, 3)).exists(Wnum) [COLOR=Navy]Then[/COLOR]
Dic(Ray(n, 3)).Add (Wnum), Array(Ray(n, 2), Ray(n, 5))
[COLOR=Navy]Else[/COLOR]
Q = Dic(Ray(n, 3)).Item(Wnum)
Q(1) = Q(1) + Ray(n, 5)
Dic(Ray(n, 3)).Item(Wnum) = Q
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] n
[COLOR=Navy]Dim[/COLOR] k        [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] p        [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] c        [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]

ReDim nray(1 To UBound(Ray, 1), 1 To 4)
c = 1
nray(1, 1) = "Payroll Name": nray(1, 2) = "File Number"
nray(1, 3) = "Week Num": nray(1, 4) = "Timecard Hours"

[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] k [COLOR=Navy]In[/COLOR] Dic.Keys
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] p [COLOR=Navy]In[/COLOR] Dic(k)
c = c + 1
nray(c, 1) = Dic(k).Item(p)(0)
nray(c, 2) = k
nray(c, 3) = p
nray(c, 4) = Dic(k).Item(p)(1)
[COLOR=Navy]Next[/COLOR] p
[COLOR=Navy]Next[/COLOR] k

[COLOR=Navy]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 4)
.Value = nray
.Borders.Weight = 2
.Columns.AutoFit
.HorizontalAlignment = xlCenter
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]``````
Regards Mick

#### MickG

##### MrExcel MVP
Because you dates where "US" formatted I had to Physically change them, I don't think that should matter , but there may be a problem with the "WeekNum" function. If you look in vbHelp you may have a problem with the WeekStart Number,You could change it to 2 for week to start on "Sunday" that then returns 37.2
Or step through the code and see what week number ("WNum") your getting at any particular line.

Try this:-
Code:
``Wnum = Application.WeekNum(CDate(Ray(n, 4)), 2)``

#### i8ur4re

##### Board Regular
Hi MickG,

I am getting the following error when running this code:
Invalid outside procedure. Highlights the n

Can you be a bit more specific as to where i should change the WeekStart Number, is this in the last code you sent me?

I have attached the actual worksheet here for further help if you dont mind, thank you in advance.

#### MickG

##### MrExcel MVP

In Post #7 code 11 rows down there is the line shown in red, you should try to Adjust it as per post #8 .

Code:
``````For n = 2 To UBound(Ray, 1)
[COLOR="#FF0000"][B]   Wnum = Application.WeekNum(Ray(n, 4))
[/B][/COLOR]            If Not Dic.exists(Ray(n, 3)) Then``````

"WeekNum" is a VB Function that you can see if you click on that word in the code module and then click "F1

Last edited:

Replies
3
Views
291
Replies
1
Views
93
Replies
3
Views
87
Replies
3
Views
267
Replies
1
Views
446