Data separated by weeks-Macros welcomed and preferred

i8ur4re

Board Regular
Joined
Mar 1, 2015
Messages
97
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.
 

Some videos you may like

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
Joined
Jan 9, 2008
Messages
14,841
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
Joined
Mar 1, 2015
Messages
97
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.

Thank you in advance.
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
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
Joined
Mar 1, 2015
Messages
97

ADVERTISEMENT

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
Joined
Jan 9, 2008
Messages
14,841
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
Joined
Mar 1, 2015
Messages
97

ADVERTISEMENT

Hi MickG,

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

XWTMary J00812601/01/20185.20REGULAR
XWTMary J00812601/02/20188.20REGULAR
XWTMary J00812601/03/20187.50REGULAR
XWTMary J00812601/04/20188.00REGULAR
XWTMary J00812601/07/20188.30REGULAR

<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?

Thank you in advance.



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
Joined
Jan 9, 2008
Messages
14,841
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
Joined
Mar 1, 2015
Messages
97
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
Joined
Jan 9, 2008
Messages
14,841
I not able to download that file !!!!


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:

Watch MrExcel Video

Forum statistics

Threads
1,108,819
Messages
5,525,080
Members
409,618
Latest member
gkllc

This Week's Hot Topics

Top