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;


Cust IDType Begin DateEnd DateNo of days
1Luxury23-Mar-1723-Mar-171
1Luxury28-Mar-1728-Mar-171
1Luxury29-Mar-1729-Mar-171
1Luxury30-Mar-1730-Mar-170.5
1Luxury31-Mar-1731-Mar-170.5
1Luxury08-Apr-1708-Apr-170.5
1Luxury08-Apr-1708-Apr-170.5
1Luxury 10-Apr-17 12-Apr-173

<tbody>
</tbody><colgroup><col><col><col><col><col></colgroup>

Output needed as below;
Cust IDType Month-YearDayTotal Days
1LuxuryMar-1723,28,29,30,314
1LuxuryApr-178,10,11,124

<tbody>
</tbody><colgroup><col><col><col><col><col></colgroup>

Regards,
motherindia

<tbody>
</tbody><colgroup><col><col><col><col><col></colgroup>
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
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.

Cust IDTypeMonth-YearDayTotal Days
1Luxury Mar-1723,28,29,30,312
1Luxury Apr-178,10,11,125

<tbody>
</tbody><colgroup><col><col><col><col><col></colgroup>
 
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 ;


2 Luxury01-04-201618-Apr-1618
2 Luxury22-Apr-1630-May-1639

<tbody>
</tbody><colgroup><col><col><col><col><col></colgroup>

Result after macro run is as follows;


2 Luxury Apr-161,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,3057
2 Luxury May-161,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,3039

<tbody>
</tbody><colgroup><col><col><col><col><col></colgroup>

But Output should be;

2 Luxury Apr-161,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,3030
2 Luxury May-161,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,3030

<tbody>
</tbody><colgroup><col><col><col><col><col></colgroup>

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
Assign Month number 1 to n based on sequential week range
Replies
6
Views
281
amolvijay
A
N
  • Locked
  • Question
Exccel - date formula that drives multiple other formulas
Replies
2
Views
187
Fluff
Fluff
A
  • Solved
AVERAGEIFS with 4 criteria
2
Replies
16
Views
380
Fluff
Fluff
A
  • Solved
Help Changing Cell Color to Based of Date referring to a specific Interior Cell Color
Replies
8
Views
338
SanjayGMusafir
SanjayGMusafir
J
  • Solved
Add 1 day to a date within a range as long as 2 conditions are met [without macros]
Replies
4
Views
594
juanam
J

Forum statistics

Threads
1,215,766
Messages
6,126,761
Members
449,336
Latest member
p17tootie

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