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]
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Sort by date Sort by votes
Try this For results on sheet2.
Code: 
[COLOR=navy]Sub[/COLOR] MG12Apr28
[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]
[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]
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] ac = 2 To 3
        Txt = Dn.Value & ", " & MonthName(Month(Dn.Offset(, ac)), True) & "-" & Right(Year(Dn.Offset(, ac).Value),2)
        [COLOR=navy]If[/COLOR] Not .Exists(Txt) [COLOR=navy]Then[/COLOR]
            .Add Txt, Array(Dn.Offset(, 4), Day(Dn.Offset(, ac)), Dn)
        [COLOR=navy]Else[/COLOR]
             Q = .Item(Txt)
             Q(0) = Q(0) + Dn.Offset(, 4).Value
             [COLOR=navy]If[/COLOR] InStr(Q(1), Day(Dn.Offset(, ac))) = 0 [COLOR=navy]Then[/COLOR]
                    Q(1) = Q(1) & "," & Day(Dn.Offset(, ac))
             [COLOR=navy]End[/COLOR] If
            .Item(Txt) = Q
        [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] ac
[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) = .Item(K)(0) / 2
[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] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
NB:- The previous code is incorrect, please try code below.
NB:- If the results are not as required, please provide more comprehensive data with expected results !!
Code: 
[COLOR=navy]Sub[/COLOR] MG12Apr42
[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]
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]
            .Add Txt, Array(Dn.Offset(, 4), Day(Dt), Dn)
        [COLOR=navy]Else[/COLOR]
             Q = .Item(Txt)
             Q(0) = Q(0) + Dn.Offset(, 4).Value
             [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) = .Item(K)(0) / 2
[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] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
Thanks a lot Sir for quick responses.
your Efforts and help is very much appreciated.

I run the macro and result is very very close to what I expected. But total days coming as follows ;
The days should have been 4 in both cases.

[TABLE="width: 342"]
<tbody>[TR]
[TD]Cust ID[/TD]
[TD]Type[/TD]
[TD]Month-Year[/TD]
[TD]Day[/TD]
[TD]Total Days[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]Luxury[/TD]
[TD] Mar-17[/TD]
[TD]23,28,29,30,31[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]Luxury[/TD]
[TD] Apr-17[/TD]
[TD]8,10,11,12[/TD]
[TD="align: right"]5[/TD]
[/TR]
</tbody><colgroup><col><col><col><col><col></colgroup>[/TABLE]
 
Upvote 0
Sorry I missed that with my previous correction.
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG12Apr26
[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]
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]
            .Add Txt, Array(Dn.Offset(, 4), 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) + Dn.Offset(, 4).Value
             [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) = .Item(K)(0)
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("Sheet6").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
 
Upvote 0
Thanks a lot Mick Sir.
Awesome. That's perfect now .
However, sorry to bother you again.
I am getting incorrect result for total days in the following ;


[TABLE="width: 801"]
<tbody>[TR]
[TD="align: right"]2[/TD]
[TD] Luxury[/TD]
[TD]01-04-2016[/TD]
[TD]18-Apr-16[/TD]
[TD]18[/TD]
[/TR]
[TR]
[TD="align: right"]2[/TD]
[TD] Luxury[/TD]
[TD]22-Apr-16[/TD]
[TD]30-May-16[/TD]
[TD]39[/TD]
[/TR]
</tbody><colgroup><col><col><col><col><col></colgroup>[/TABLE]

Result after macro run is as follows;


[TABLE="width: 801"]
<tbody>[TR]
[TD="align: right"]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="align: right"]57[/TD]
[/TR]
[TR]
[TD="align: right"]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="align: right"]39[/TD]
[/TR]
</tbody><colgroup><col><col><col><col><col></colgroup>[/TABLE]

But Output should be;

[TABLE="width: 801"]
<tbody>[TR]
[TD="align: right"]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="align: right"]30[/TD]
[/TR]
[TR]
[TD="align: right"]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="align: right"]30[/TD]
[/TR]
</tbody><colgroup><col><col><col><col><col></colgroup>[/TABLE]

Thanks a lot again.

Please let me know if this is possible.
really sorry to bother you again.


Regards,
motherindia
 
Upvote 0
The trouble is you've moved the goalposts slightly !!!!
With your original data the results were based on "I/D" and "Month", with the Total being the sum of that month in column "E".
Now you have 2 months on the same line, which creates a problem with how you now want your results to show,and how you should add up column "E" with what would be overlapping months.

Your new data "E" shows number of days as 18, and 39. I can't see how you now get a result of 30 and 30.
In order to alter the code I would need to see some more comprehensive data/results that reflects a logic that enables me to write code that produces consistent Results.!!
Regrds Mick
 
Upvote 0
Hello Mick Sir.
Extremely sorry for miscommunication.
The result should be 27 days for Apr 16 and 30 days for May16 instead of 30 days and 30 days respectively.
It was typo.
Once again thanks a lot .

Regards,
motherindia
 
Upvote 0
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 ?????
 
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
36
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
6
Views
122
Kaper
Kaper
N
  • Locked
  • Question Question
Exccel - date formula that drives multiple other formulas
Replies
2
Views
412
Fluff
Fluff

Forum statistics

Threads
1,224,893
Messages
6,181,617
Members
453,057
Latest member
LE102024

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