Segregation of Dates based on DOW (Numeric)

[shansakhi]

Hello Everybody,
Need your assistance.
Is there a way we can segregates dates based on DOW (Day of week - numeric).
The data can come in any format.
Below sample data for your reference...

RAW DATA (Here DOW numeric = 1-MON,2-TUE, 3-WED,4-THU,5-FRI,6-SAT,7-SUN)

INPUT OUTPUT

Eff Date	Dis Date	DOW	Date	DOW
28-Dec-18	31-Dec-18	15	28-Dec-18	5
			31-Dec-18	1
13-Dec-18	16-Dec-18	457	13-Dec-18	4
			14-Dec-18	5
			16-Dec-18	7
5-Dec-18	6-Dec-18	34	5-Dec-18	3
			6-Dec-18	4
24-Dec-18	31-Dec-18	1357	24-Dec-18	1
			26-Dec-18	3
			28-Dec-18	5
			30-Dec-18	7
			31-Dec-18	1

<tbody>
</tbody>

Thank you in Advance.

Regards,
Shan

 

[Akuini]

Hi,
Need you help.
The code is working fine. Currently its providing output in D and E column.. Is it possible to provide this output end of all used column.

OK, try this :

[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1076113b()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1076113-segregation-dates-based-dow-numeric.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], j [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], k [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], q [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], g [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] va [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Variant[/COLOR], vb [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Variant[/COLOR], vc [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Variant[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] stDate [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Date[/COLOR], enDate [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Date[/COLOR], d [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Date[/COLOR]


rc = Cells([COLOR=crimson]1[/COLOR], Columns.count).[COLOR=Royalblue]End[/COLOR](xlToLeft).Column
ra = Range([COLOR=brown]"A"[/COLOR] & Rows.count).[COLOR=Royalblue]End[/COLOR](xlUp).Row
va = Range(Cells([COLOR=crimson]2[/COLOR], [COLOR=brown]"A"[/COLOR]), Cells(ra, rc))

[COLOR=Royalblue]ReDim[/COLOR] vb([COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR]) * [COLOR=crimson]10[/COLOR], [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]2[/COLOR])
[COLOR=Royalblue]ReDim[/COLOR] vc([COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR]) * [COLOR=crimson]10[/COLOR], [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]2[/COLOR]))

[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
    stDate = va(i, [COLOR=crimson]1[/COLOR])
    enDate = va(i, [COLOR=crimson]2[/COLOR])
      [COLOR=Royalblue]For[/COLOR] d = stDate [COLOR=Royalblue]To[/COLOR] enDate
            q = Weekday(d) - [COLOR=crimson]1[/COLOR]
            [COLOR=Royalblue]If[/COLOR] q = [COLOR=crimson]0[/COLOR] [COLOR=Royalblue]Then[/COLOR] q = [COLOR=crimson]7[/COLOR]
                [COLOR=Royalblue]If[/COLOR] q [COLOR=Royalblue]Like[/COLOR] [COLOR=brown]"["[/COLOR] & Trim(va(i, [COLOR=crimson]3[/COLOR])) & [COLOR=brown]"]"[/COLOR] [COLOR=Royalblue]Then[/COLOR]
                    j = j + [COLOR=crimson]1[/COLOR]
                    k = k + [COLOR=crimson]1[/COLOR]
                    vb(j, [COLOR=crimson]1[/COLOR]) = d
                    vb(j, [COLOR=crimson]2[/COLOR]) = q
                [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
      [COLOR=Royalblue]Next[/COLOR]
        
    [COLOR=Royalblue]For[/COLOR] g = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]2[/COLOR])
    vc(j - k + [COLOR=crimson]1[/COLOR], g) = va(i, g)
    [COLOR=Royalblue]Next[/COLOR]
        k = [COLOR=crimson]0[/COLOR]
[COLOR=Royalblue]Next[/COLOR]
Range([COLOR=brown]"A2"[/COLOR]).Resize([COLOR=crimson]1[/COLOR], rc).Copy
Range([COLOR=brown]"A2"[/COLOR]).Resize(j, rc).PasteSpecial xlPasteFormats
Range([COLOR=brown]"A2"[/COLOR]).Copy
Cells([COLOR=crimson]2[/COLOR], rc + [COLOR=crimson]1[/COLOR]).Resize(j, [COLOR=crimson]1[/COLOR]).PasteSpecial xlPasteFormats
Range([COLOR=brown]"A2"[/COLOR]).Resize(j, rc) = vc
Cells([COLOR=crimson]2[/COLOR], rc + [COLOR=crimson]1[/COLOR]).Resize(j, [COLOR=crimson]2[/COLOR]) = vb

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]

 

[shansakhi]

Wow! You are really great !! It's working exactly as desired !! Thank you so much.

 

[Akuini]

You're welcome.