Complete missing dates

P

Panoos64

Well-known Member
Joined
Mar 1, 2014
Messages
882
Hi all, i would like to support me so that to create a vba code, which should run through col. "C" and complete the missing dates by inserting a new row. Please note that the code should complete based on month's days. e.g. 30 or 31 or 28 The employees are 200+ and for each one i would like to complete the missing dates. below is an extract of the original data. Many thanks in advance.


ABC
1I.D.NameDate
21555EMPL. 155501-12-17
31555EMPL. 155504-12-17
41555EMPL. 155505-12-17
51555EMPL. 155506-12-17
61555EMPL. 155507-12-17
71555EMPL. 155508-12-17
81555EMPL. 155511-12-17
91555EMPL. 155512-12-17
101555EMPL. 155513-12-17
111555EMPL. 155514-12-17
121555EMPL. 155515-12-17
131555EMPL. 155518-12-17
141555EMPL. 155519-12-17
151555EMPL. 155520-12-17
161555EMPL. 155521-12-17
171555EMPL. 155522-12-17
181555EMPL. 155527-12-17
191555EMPL. 155528-12-17
201555EMPL. 155529-12-17
211555 Count
221555 Total
23
241578EMPL. 157801-12-17
251578EMPL. 157804-12-17
261578EMPL. 157805-12-17
271578EMPL. 157806-12-17
281578EMPL. 157807-12-17
291578EMPL. 157808-12-17
301578EMPL. 157811-12-17
311578EMPL. 157812-12-17
321578EMPL. 157813-12-17
331578EMPL. 157814-12-17
341578EMPL. 157815-12-17
351578EMPL. 157818-12-17
361578EMPL. 157819-12-17
371578EMPL. 157820-12-17
381578EMPL. 157821-12-17
391578EMPL. 157822-12-17
401578EMPL. 157827-12-17
411578EMPL. 157828-12-17
421578EMPL. 157829-12-17
431578 Count
441578 Total
45

<tbody>
</tbody>
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Sort by date Sort by votes
Try this:-
Results start "E1"
Code: 
[COLOR=navy]Sub[/COLOR] MG17Jan14
[COLOR=navy]Dim[/COLOR] n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Dat [COLOR=navy]As[/COLOR] Date, Num [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Mth [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Yr [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, K [COLOR=navy]As[/COLOR] Variant, Dt [COLOR=navy]As[/COLOR] Date, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
c = 1
Range("E1").Resize(, 3).Value = Array("I.D.", "Name", "Date")
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]If[/COLOR] Dn.Offset(, 1).Value <> "" [COLOR=navy]Then[/COLOR]
        [COLOR=navy]If[/COLOR] Not .Exists(Dn.Value & "," & Dn.Offset(, 1).Value) [COLOR=navy]Then[/COLOR]
            .Add Dn.Value & "," & Dn.Offset(, 1).Value, DateSerial(Year(Dn.Offset(, 2).Value), Month(Dn.Offset(, 2).Value), 1)
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
    [COLOR=navy]For[/COLOR] n = 1 To 12
        [COLOR=navy]If[/COLOR] n = Month(.Item(K)) [COLOR=navy]Then[/COLOR]
            [COLOR=navy]If[/COLOR] n = 12 [COLOR=navy]Then[/COLOR]
                Mth = 1: Yr = Year(DateAdd("yyyy", 1, Dat))
            [COLOR=navy]Else[/COLOR]
                Mth = n + 1: Yr = Year(Dat)
            [COLOR=navy]End[/COLOR] If
            Num = Day(DateAdd("d", -1, DateSerial(Yr, Mth, 1)))
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] n

Dt = DateAdd("d", -1, CDate(.Item(K)))
    [COLOR=navy]For[/COLOR] n = 1 To Num
        c = c + 1
        Cells(c, "E") = Split(K, ",")(0)
        Cells(c, "F") = Split(K, ",")(1)
        Cells(c, "G") = DateAdd("d", n, Dt)
    [COLOR=navy]Next[/COLOR] n
        c = c + 1
        Cells(c, "E") = Split(K, ",")(0) & " " & "Count"
        c = c + 1
        Cells(c, "E") = Split(K, ",")(0) & " " & "Total"
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
Hi Mick and many thanks for your support. The code works but, i wanted to insert entire rows for missing dates, entering the missing date in the same column "C" so that to know the dates for each employee, (she's /he's) days off. Apologies that i did not present exactly the original data. I would be greatly appreciate if you could modify the code.
I present below an extract of complete data. Thanks once again for your support. Have a great day!


A
BCDEF
1I.D.NameDateINOUTTotal Time
21555EMPL. 15551/12/20177:45:2017:43:319:58
31555EMPL. 15554/12/20177:46:0618:01:0710:15
41555EMPL. 15555/12/20177:57:0618:11:0610:14
51555EMPL. 15556/12/20177:46:3416:25:498:39
61555EMPL. 15557/12/20177:39:4511:30:203:91
71555EMPL. 15558/12/20177:45:1817:43:499:58
81555EMPL. 155511/12/20177:43:0717:26:029:43
91555EMPL. 155512/12/20177:43:5417:54:3510:11
101555EMPL. 155513/12/20178:11:1916:50:178:39
111555EMPL. 155514/12/20177:55:3017:29:329:34
121555EMPL. 155515/12/20177:43:3612:30:204:87
131555EMPL. 155518/12/20177:43:3117:04:099:21
141555EMPL. 155519/12/20177:40:0816:41:419:01
151555EMPL. 155520/12/20177:41:3517:20:329:39
161555EMPL. 155521/12/20177:39:2317:02:599:23
171555EMPL. 155522/12/20177:44:4016:45:479:01
181555EMPL. 155527/12/20177:43:0216:52:569:09
191555EMPL. 155528/12/20177:50:0617:39:089:49
201555EMPL. 155529/12/20177:42:0217:16:479:34
211555 Count
221555 Total
23
241578EMPL. 15781/12/20178:59:2217:47:468:48
251578EMPL. 15784/12/20179:04:5417:44:308:40
261578EMPL. 15785/12/20179:15:5817:50:328:35
271578EMPL. 15786/12/20179:16:0617:48:028:32
281578EMPL. 15787/12/20179:10:1517:57:158:47
291578EMPL. 15788/12/20179:16:2618:00:218:44
301578EMPL. 157811/12/20178:57:3317:49:088:52
311578EMPL. 157812/12/20179:11:4717:50:188:39
321578EMPL. 157813/12/20179:22:2017:43:478:21
331578EMPL. 157814/12/20179:24:0117:42:298:18
341578EMPL. 157815/12/20179:21:5917:48:478:27
351578EMPL. 157818/12/20179:18:1617:59:358:41
361578EMPL. 157819/12/20179:22:1118:07:048:45
371578EMPL. 157820/12/20179:25:4617:55:058:30
381578EMPL. 157821/12/20179:22:2218:04:418:42
391578EMPL. 157822/12/20179:24:2118:13:598:49
401578EMPL. 157827/12/20179:34:3711:41:037:54
411578EMPL. 157828/12/20178:26:4917:45:219:19
421578EMPL. 157829/12/20178:45:5117:44:018:59
431578 Count
441578 Total

<tbody>
</tbody>
 
Upvote 0
Try this for results on sheet2.
NB:- Columns 3 to 6 of missing dates, are now shown as blank.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG18Jan53
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dat [COLOR="Navy"]As[/COLOR] Date, Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Mth [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Yr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant, Dt [COLOR="Navy"]As[/COLOR] Date, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, Ray [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] nDt [COLOR="Navy"]As[/COLOR] Date
 c = 1
Ray = Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 6)
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   [COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
        [COLOR="Navy"]If[/COLOR] Ray(n, 2) <> "" [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] Not Dic.exists(Ray(n, 1) & "," & Ray(n, 2)) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]Set[/COLOR] Dic(Ray(n, 1) & "," & Ray(n, 2)) = CreateObject("Scripting.Dictionary")
        [COLOR="Navy"]End[/COLOR] If
        
        [COLOR="Navy"]If[/COLOR] Not Dic(Ray(n, 1) & "," & Ray(n, 2)).exists(Ray(n, 3)) [COLOR="Navy"]Then[/COLOR]
                Dic(Ray(n, 1) & "," & Ray(n, 2)).Add Ray(n, 3), Array(Ray(n, 4), Ray(n, 5), Ray(n, 6))
        [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
   
ReDim nRay(1 To (Dic.Count + 3) * 31, 1 To 6)
nRay(1, 1) = "I.D.": nRay(1, 2) = "Name": nRay(1, 3) = "Date"
nRay(1, 4) = "IN": nRay(1, 5) = "OUT": nRay(1, 6) = "Total Time"
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.keys
    [COLOR="Navy"]For[/COLOR] n = 1 To 12
        [COLOR="Navy"]If[/COLOR] n = Month(Dic(k).keys()(0)) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] n = 12 [COLOR="Navy"]Then[/COLOR]
                Mth = 1: Yr = Year(DateAdd("yyyy", 1, Dat))
            [COLOR="Navy"]Else[/COLOR]
                Mth = n + 1: Yr = Year(Dat)
            [COLOR="Navy"]End[/COLOR] If
            Num = Day(DateAdd("d", -1, DateSerial(Yr, Mth, 1)))
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
nDt = DateSerial(Year(Dic(k).keys()(0)), Month(Dic(k).keys()(0)), 1)
Dt = DateAdd("d", -1, CDate(nDt))
    [COLOR="Navy"]For[/COLOR] n = 1 To Num
        c = c + 1
        nRay(c, 1) = Split(k, ",")(0)
        nRay(c, 2) = Split(k, ",")(1)
        nRay(c, 3) = DateAdd("d", n, Dt)
            [COLOR="Navy"]If[/COLOR] Dic(k).exists(DateAdd("d", n, Dt)) [COLOR="Navy"]Then[/COLOR]
                nRay(c, 4) = Format(Dic(k).Item(DateAdd("d", n, Dt))(0), "hh:mm:ss")
                nRay(c, 5) = Format(Dic(k).Item(DateAdd("d", n, Dt))(1), "hh:mm:ss")
                nRay(c, 6) = Format(Dic(k).Item(DateAdd("d", n, Dt))(2), "hh:mm:ss")
             [COLOR="Navy"]End[/COLOR] If
   [COLOR="Navy"]Next[/COLOR] n
        c = c + 1
        nRay(c, 1) = Split(k, ",")(0) & " " & "Count"
        c = c + 1
        nRay(c, 1) = Split(k, ",")(0) & " " & "Total"
[COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]With[/COLOR] Sheets("Sheet13").Range("A1").Resize(c, 6)
    .Value = nRay
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Typo!!!!!
The following line at end of code should read :-
Code: 
[COLOR=#000080]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 6)

Please amend code !!
 
Upvote 0
Perfect work Mick! Really i appreciated for what you done for me and especially the solutions for my projects. You support me once again and i owe to you a great thanks. My best wishes to you. Have a great lovely day!
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
Excel Formula to highlight most recent record
Replies
3
Views
99
etaf
etaf
J
  • Solved
Add 1 day to a date within a range as long as 2 conditions are met [without macros]
Replies
4
Views
565
juanam
J
A
  • Question
Assign Month number 1 to n based on sequential week range
Replies
6
Views
254
amolvijay
A
A
  • Solved
AVERAGEIFS with 4 criteria
2
Replies
16
Views
313
Fluff
Fluff
K
  • Question
Excel Pivot table Time Values is not populating same as Source Sheet
Replies
1
Views
310
awoohaw
awoohaw

Forum statistics

Threads
1,214,979
Messages
6,122,550
Members
449,088
Latest member
davidcom

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