VBA to split start date and end date into days per month in separate rows

M

motherindia

Board Regular
Joined
Oct 15, 2015
Messages
218
Hello Sir
I have data on sheet1 as follows;


[TABLE="width: 636"]
<tbody>[TR]
[TD]Cust ID[/TD]
[TD]Type [/TD]
[TD]Begin Date[/TD]
[TD]End Date[/TD]
[TD]No of days[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]Luxury[/TD]
[TD="align: right"]23-Mar-17[/TD]
[TD="align: right"]23-Mar-17[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]Luxury[/TD]
[TD="align: right"]28-Mar-17[/TD]
[TD="align: right"]28-Mar-17[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]Luxury[/TD]
[TD="align: right"]29-Mar-17[/TD]
[TD="align: right"]29-Mar-17[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]Luxury[/TD]
[TD="align: right"]30-Mar-17[/TD]
[TD="align: right"]30-Mar-17[/TD]
[TD="align: right"]0.5[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]Luxury[/TD]
[TD="align: right"]31-Mar-17[/TD]
[TD="align: right"]31-Mar-17[/TD]
[TD="align: right"]0.5[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]Luxury[/TD]
[TD="align: right"]08-Apr-17[/TD]
[TD="align: right"]08-Apr-17[/TD]
[TD="align: right"]0.5[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]Luxury[/TD]
[TD="align: right"]08-Apr-17[/TD]
[TD="align: right"]08-Apr-17[/TD]
[TD="align: right"]0.5[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]Luxury [/TD]
[TD] 10-Apr-17[/TD]
[TD] 12-Apr-17[/TD]
[TD="align: right"]3[/TD]
[/TR]
</tbody><colgroup><col><col><col><col><col></colgroup>[/TABLE]

Output needed as below;
[TABLE="width: 636"]
<tbody>[TR]
[TD]Cust ID[/TD]
[TD]Type [/TD]
[TD]Month-Year[/TD]
[TD]Day[/TD]
[TD]Total Days[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Luxury[/TD]
[TD]Mar-17[/TD]
[TD]23,28,29,30,31[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Luxury[/TD]
[TD]Apr-17[/TD]
[TD]8,10,11,12[/TD]
[TD="align: right"]4[/TD]
[/TR]
</tbody><colgroup><col><col><col><col><col></colgroup>[/TABLE]

[TABLE="width: 599"]
<tbody>[TR]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"][/TD]
[TD][/TD]
[TD="align: right"][/TD]
[TD][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: right"]Regards,
motherindia[/TD]
[TD][/TD]
[TD="align: right"][/TD]
[TD][/TD]
[TD="align: right"][/TD]
[/TR]
</tbody><colgroup><col><col><col><col><col></colgroup>[/TABLE]
 
Sort by date Sort by votes
Thanks once again Mick Sir.
You can go by days and if there is one half day only then you can show it as half day and if there is two line with half days, then you can combine it as one day and get the unique days for month.

Regards,
motherindia
 
Upvote 0

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
The result here would be as follows:-
Is that acceptable
[TABLE="width: 539"]
<colgroup><col width="49" style="width: 37pt; mso-width-source: userset; mso-width-alt: 1735;"> <col width="46" style="width: 34pt; mso-width-source: userset; mso-width-alt: 1621;"> <col width="78" style="width: 58pt; mso-width-source: userset; mso-width-alt: 2759;"> <col width="478" style="width: 358pt; mso-width-source: userset; mso-width-alt: 16981;"> <col width="69" style="width: 52pt; mso-width-source: userset; mso-width-alt: 2446;"> <tbody>[TR]
[TD="class: xl63, width: 49, bgcolor: transparent"]Cust ID[/TD]
[TD="class: xl63, width: 46, bgcolor: transparent"]Type[/TD]
[TD="class: xl63, width: 78, bgcolor: transparent"]Month-Year[/TD]
[TD="class: xl63, width: 478, bgcolor: transparent"]Day[/TD]
[TD="class: xl63, width: 69, bgcolor: transparent"]Total Days[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent, align: right"]1[/TD]
[TD="class: xl63, bgcolor: transparent"]Luxury[/TD]
[TD="class: xl63, bgcolor: transparent"] Mar-17[/TD]
[TD="class: xl63, bgcolor: transparent"]23,28,29,30,31[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]4[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent, align: right"]1[/TD]
[TD="class: xl63, bgcolor: transparent"]Luxury[/TD]
[TD="class: xl63, bgcolor: transparent"] Apr-17[/TD]
[TD="class: xl63, bgcolor: transparent"]8,10,11,12[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]3[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent, align: right"]2[/TD]
[TD="class: xl63, bgcolor: transparent"]Luxury[/TD]
[TD="class: xl63, bgcolor: transparent"] Apr-16[/TD]
[TD="class: xl63, bgcolor: transparent"]1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,22,23,24,25,26,27,28,29,30[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]27[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent, align: right"]2[/TD]
[TD="class: xl63, bgcolor: transparent"]Luxury[/TD]
[TD="class: xl63, bgcolor: transparent"] May-16[/TD]
[TD="class: xl63, bgcolor: transparent"]1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]30[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
MickG said:
The logic of your last post is to count the number of days in the Unique month, in these two cases 27 & 30, but if you go back to "March" and "April" the Result from column "E" is Based on the Sum of the Values in "E". in those cases 4, because you have a number of "0.5's"
So you now have two criteria :- Sum or Days,
How do you want to resolve this ?????
Click to expand...

Yes sir will do.
 
Upvote 0
Try this for Results on sheet2:-
Code: 
[COLOR=navy]Sub[/COLOR] MG14Apr12
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Txt [COLOR=navy]As[/COLOR] [COLOR=navy]String,[/COLOR] Dt [COLOR=navy]As[/COLOR] Date
[COLOR=navy]Dim[/COLOR] K [COLOR=navy]As[/COLOR] Variant, ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Q [COLOR=navy]As[/COLOR] Variant, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Frac [COLOR=navy]As[/COLOR] Double
c = 1
[COLOR=navy]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]For[/COLOR] Dt = Dn.Offset(, 2) To Dn.Offset(, 3)
        Txt = Dn.Value & ", " & MonthName(Month(Dt), True) & "-" & Right(Year(Dt), 2)
        [COLOR=navy]If[/COLOR] Not .Exists(Txt) [COLOR=navy]Then[/COLOR]
            Frac = IIf(Dn.Offset(, 4) = 0.5, 0.5, 0)
            .Add Txt, Array(Frac, Day(Dt), Dn)
        [COLOR=navy]Else[/COLOR]
             Q = .Item(Txt)
             [COLOR=navy]If[/COLOR] Not Dn.Address = Q(2).Address [COLOR=navy]Then[/COLOR]
                
                Q(0) = Q(0) + IIf(Dn.Offset(, 4) = 0.5, 0.5, 0) 
             [COLOR=navy]Set[/COLOR] Q(2) = Dn
             [COLOR=navy]End[/COLOR] If
             [COLOR=navy]If[/COLOR] InStr(Q(1), Day(Dt)) = 0 [COLOR=navy]Then[/COLOR]
                    Q(1) = Q(1) & "," & Day(Dt)
             [COLOR=navy]End[/COLOR] If
            .Item(Txt) = Q
        [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Dt
[COLOR=navy]Next[/COLOR]
ReDim ray(1 To .Count + 1, 1 To 5)
ray(1, 1) = "Cust ID": ray(1, 2) = "Type": ray(1, 3) = "Month-Year": ray(1, 4) = "Day": ray(1, 5) = "Total Days"
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
    c = c + 1
    ray(c, 1) = Split(K, ",")(0)
    ray(c, 2) = .Item(K)(2).Offset(, 1)
    ray(c, 3) = Split(K, ",")(1)
    ray(c, 4) = .Item(K)(1)
    ray(c, 5) = UBound(Split(.Item(K)(1), ",")) + 1 - .Item(K)(0)
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] With
[COLOR=navy]With[/COLOR] Sheets("Sheet2").Range("a1").Resize(c, 5)
    .Value = ray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR=navy]End[/COLOR] With
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
Hello Mick Sir,
Thank you all for your help -it has been much appreciated. Your code works fine now and also amazing code.
In fact I had labouriously trying it out just before I saw your post.
Thank you again for your help - problem solved!

Regards,
motherindia
 
Upvote 0
Hello Mick ,

Sorry to bother you once again. Is it possible to have combined consecutive days as single range ie if I have days like, 1,2,3,5,7,8,9 as 1-3,5,7-9 etc.. in another column (please refer the last column in below example )

[TABLE="width: 1762"]
<tbody>[TR]
[TD]Cust ID[/TD]
[TD]Type[/TD]
[TD]Month-Year[/TD]
[TD]Day[/TD]
[TD]Total Days[/TD]
[TD]Days Range[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Luxury[/TD]
[TD]Mar-17[/TD]
[TD]23,28,29,30,31[/TD]
[TD]4[/TD]
[TD]23,28-31[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Luxury[/TD]
[TD]Apr-17[/TD]
[TD]8,10,11,12[/TD]
[TD]4[/TD]
[TD]8,10-12[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Luxury[/TD]
[TD]Apr-16[/TD]
[TD]1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,22,23,24,25,26,27,28,29,30[/TD]
[TD]27[/TD]
[TD]1-18,22-30[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Luxury[/TD]
[TD]May-16[/TD]
[TD]1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30[/TD]
[TD]30[/TD]
[TD]1-30[/TD]
[/TR]
</tbody><colgroup><col span="3"><col><col><col></colgroup>[/TABLE]


Thanks once again.

Regards,
motherindia.
 
Upvote 0
Try this:-
Code: 
[COLOR=navy]Sub[/COLOR] MG04May27
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] TxT [COLOR=navy]As[/COLOR] [COLOR=navy]String,[/COLOR] Dt [COLOR=navy]As[/COLOR] Date
[COLOR=navy]Dim[/COLOR] K [COLOR=navy]As[/COLOR] Variant, ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Q [COLOR=navy]As[/COLOR] Variant, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Frac [COLOR=navy]As[/COLOR] Double
c = 1
[COLOR=navy]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]For[/COLOR] Dt = Dn.Offset(, 2) To Dn.Offset(, 3)
        TxT = Dn.Value & ", " & MonthName(Month(Dt), True) & "-" & Right(Year(Dt), 2)
        [COLOR=navy]If[/COLOR] Not .Exists(TxT) [COLOR=navy]Then[/COLOR]
            Frac = IIf(Dn.Offset(, 4) = 0.5, 0.5, 0)
            .Add TxT, Array(Frac, Day(Dt), Dn)
        [COLOR=navy]Else[/COLOR]
             Q = .Item(TxT)
             [COLOR=navy]If[/COLOR] Not Dn.Address = Q(2).Address [COLOR=navy]Then[/COLOR]
                
                Q(0) = Q(0) + IIf(Dn.Offset(, 4) = 0.5, 0.5, 0)
             [COLOR=navy]Set[/COLOR] Q(2) = Dn
             [COLOR=navy]End[/COLOR] If
             [COLOR=navy]If[/COLOR] InStr(Q(1), Day(Dt)) = 0 [COLOR=navy]Then[/COLOR]
                    Q(1) = Q(1) & "," & Day(Dt)
             [COLOR=navy]End[/COLOR] If
            .Item(TxT) = Q
        [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Dt
[COLOR=navy]Next[/COLOR]
[COLOR=navy]Dim[/COLOR] Mystrg [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
ReDim Ray(1 To .Count + 1, 1 To 5)
Ray(1, 1) = "Cust ID": Ray(1, 2) = "Type": Ray(1, 3) = "Month-Year": Ray(1, 4) = "Day": Ray(1, 5) = "Total Days"
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
    c = c + 1
    Ray(c, 1) = Split(K, ",")(0)
    Ray(c, 2) = .Item(K)(2).Offset(, 1)
    Ray(c, 3) = Split(K, ",")(1)
    Mystrg = .Item(K)(1)
    Ray(c, 4) = jTxt(Mystrg)
    Ray(c, 5) = UBound(Split(.Item(K)(1), ",")) + 1 - .Item(K)(0)
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] With
[COLOR=navy]With[/COLOR] Sheets("Sheet2").Range("a1").Resize(c, 5)
    .Value = Ray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR=navy]End[/COLOR] With
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]




Function jTxt(TxT [COLOR=navy]As[/COLOR] String) [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Dim[/COLOR] n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Sp [COLOR=navy]As[/COLOR] Variant, num [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Ray(), Q [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
  .CompareMode = vbTextCompare
    Sp = Split(TxT, ",")
[COLOR=navy]For[/COLOR] n = 0 To UBound(Sp)
    [COLOR=navy]If[/COLOR] .Count = 0 [COLOR=navy]Then[/COLOR]
        num = 1
    [COLOR=navy]ElseIf[/COLOR] n > 0 And Not Val(Sp(n)) = Val(Sp(n - 1)) + 1 [COLOR=navy]Then[/COLOR]
        num = num + 1: c = 0
    [COLOR=navy]End[/COLOR] If
        [COLOR=navy]If[/COLOR] Not .Exists(CStr(num)) [COLOR=navy]Then[/COLOR]
            c = c + 1
            ReDim Preserve Ray(c)
            Ray(c) = Sp(n)
           .Add CStr(num), Ray
        [COLOR=navy]Else[/COLOR]
           Q = .Item(CStr(num))
            c = c + 1
            ReDim Preserve Q(c)
           Q(c) = Sp(n)
       .Item(CStr(num)) = Q
        [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
[COLOR=navy]Dim[/COLOR] K [COLOR=navy]As[/COLOR] Variant, nStr [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
    nStr = nStr & ", " & IIf(.Item(K)(1) = .Item(K)(UBound(.Item(K))), .Item(K)(1), .Item(K)(1) & "-" & .Item(K)(UBound(.Item(K))))
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] With
jTxt = Mid(nStr, 2)
[COLOR=navy]End[/COLOR] Function
Regards Mick
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Assign Month number 1 to n based on sequential week range
Replies
6
Views
487
amolvijay
A
J
  • Question Question
auto filling cells based on preset format
Replies
1
Views
37
HighAndWilder
H
V
  • Question Question
Calculate days between date or directly days comparison
Replies
2
Views
286
vishu
V
B
  • Solved
timestamp listing to show more than >19hrs away per day?
Replies
7
Views
129
Boboka
B
N
  • Locked
  • Question Question
Exccel - date formula that drives multiple other formulas
Replies
2
Views
412
Fluff
Fluff

Forum statistics

Threads
1,224,915
Messages
6,181,724
Members
453,064
Latest member
robatthe2A

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