Data separated by weeks-Macros welcomed and preferred

[i8ur4re]

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.

 

[MickG]

Try this:-
The code assumes the "Payroll Names" start "A2" there are 4 columns of data and the results start "A1" sheet2.

[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

 

[i8ur4re]

Try this:-
The code assumes the "Payroll Names" start "A2" there are 4 columns of data and the results start "A1" sheet2.

[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]

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]

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.

 

[MickG]

Try this , Results sheet2

[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]

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.20	REGULAR
XWT	Mary J	008126	01/02/2018	8.20	REGULAR
XWT	Mary J	008126	01/03/2018	7.50	REGULAR
XWT	Mary J	008126	01/04/2018	8.00	REGULAR
XWT	Mary J	008126	01/07/2018	8.30	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?

Thank you in advance.

Try this , Results sheet2

[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]

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

Wnum = Application.WeekNum(CDate(Ray(n, 4)), 2)

 

[i8ur4re]

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]

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 .

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