Data separated by weeks-Macros welcomed and preferred

I

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.
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
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:
Upvote 0
MickG said:
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
Click to expand...


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.
 
Upvote 0
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. !!
 
Upvote 0
MickG said:
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. !!
Click to expand...

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:
Upvote 0
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
 
Upvote 0
Hi MickG,

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

[TABLE="width: 1070"]
<colgroup><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]XWT[/TD]
[TD]Mary J[/TD]
[TD]008126[/TD]
[TD]01/01/2018[/TD]
[TD]5.20[/TD]
[TD]REGULAR[/TD]
[/TR]
[TR]
[TD]XWT[/TD]
[TD]Mary J[/TD]
[TD]008126[/TD]
[TD]01/02/2018[/TD]
[TD]8.20[/TD]
[TD]REGULAR[/TD]
[/TR]
[TR]
[TD]XWT[/TD]
[TD]Mary J[/TD]
[TD]008126[/TD]
[TD]01/03/2018[/TD]
[TD]7.50[/TD]
[TD]REGULAR[/TD]
[/TR]
[TR]
[TD]XWT[/TD]
[TD]Mary J[/TD]
[TD]008126[/TD]
[TD]01/04/2018[/TD]
[TD]8.00[/TD]
[TD]REGULAR[/TD]
[/TR]
[TR]
[TD]XWT[/TD]
[TD]Mary J[/TD]
[TD]008126[/TD]
[TD]01/07/2018[/TD]
[TD]8.30[/TD]
[TD]REGULAR
[/TD]
[/TR]
</tbody>[/TABLE]

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.



MickG said:
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
Click to expand...
 
Upvote 0
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)
 
Upvote 0
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.
 
Upvote 0
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:
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question Question
Rolling Count
Replies
1
Views
470
awoohaw
awoohaw
Dazzawm
  • Solved
Macro To Find Latest Date To Corresponding Data In Column B And Add To Sheet 2
Replies
7
Views
344
Fuji
F
A
  • Question Question
Allocate the Hours based on Interval covered
Replies
1
Views
466
Jeffrey Mahoney
Jeffrey Mahoney
S
  • Solved
IF function excluding 0 and 9 in text string
Replies
4
Views
358
dreid1011
dreid1011
1
  • Question Question
Auto filter column on vlookup update on every sheets of the workbook
Replies
1
Views
327
10ml
1

Forum statistics

Threads
1,224,821
Messages
6,181,163
Members
453,021
Latest member
Justyna P

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