VBA Code to split week ranges into separate lines.

[markster]

Hello everyone

Right I have a problem that I just can’t solve. I’ve posted something similar before and someone suggested power query but I don’t know it, never used it (although I will do as it looks great) but I have a big scheduling job and not much time so a VBA solution would be the best option for now.

So I have a workbook and there are 3 Sheets

Sheet 1 is a extract of a 1000+ line spreadsheet that I need to split into individual lines based on the data in Column F which relates to week numbers in which teaching is going to take place.

20210923 - Data Download from Timetabling System.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L
1	Reference	Course Name	Room Number	Location	Allocated Teacher	Scheduled Weeks	Scheduled Days	Planned Size	Size	Scheduled Start Time	Scheduled End Time	Duration
2	0001	Course 1	23	London	Teacher 1	1, 5, 8-9	Tuesday	0	0	9:00	10:00	01:00
3	0002	Course 2	24	Birmingham	Teacher 2	3-5, 10-12, 16, 19	Wednesday	0	0	9:00	10:00	01:00
4	0003	Course 3	28	Manchester	Teacher 3	17, 22	Tuesday	0	0	9:00	10:00	01:00
5	0004	Course 4	23	London	Teacher 4	8	Tuesday	0	0	9:00	10:00	01:00
6	0005	Course 5	23	London	Teacher 5	3	Tuesday	0	0	9:00	10:00	01:00
Sheet1

The data in COLUMN F is in the format of week numbers so you will see that it can be entered as a week range e.g. 1-5 or Singles weeks like 1, or several weeks 1,5,6 or a combination of these. So you will see in the example below, COLUMN F3 shows 3-5, 10-12, 16, 19

So Course 2 is being taught on a Wednesday on weeks 3 to 5 and then weeks 10-12 and then on week 16 and week 19.

Sheet 2 contains a list of all week numbers and dates which Sheet 1 should reference

20210923 - Data Download from Timetabling System.xlsx
	A	B	C	D	E	F
1	Week No.	Monday	Tuesday	Wednesday	Thursday	Friday
2	1	27/9/2021	28/9/2021	29/9/2021	30/9/2021	1/10/2021
3	2	4/10/2021	5/10/2021	6/10/2021	7/10/2021	8/10/2021
4	3	11/10/2021	12/10/2021	13/10/2021	14/10/2021	15/10/2021
5	4	18/10/2021	19/10/2021	20/10/2021	21/10/2021	22/10/2021
6	5	25/10/2021	26/10/2021	27/10/2021	28/10/2021	29/10/2021
7	6	1/11/2021	2/11/2021	3/11/2021	4/11/2021	5/11/2021
8	7	8/11/2021	9/11/2021	10/11/2021	11/11/2021	12/11/2021
9	8	15/11/2021	16/11/2021	17/11/2021	18/11/2021	19/11/2021
10	9	22/11/2021	23/11/2021	24/11/2021	25/11/2021	26/11/2021
11	10	29/11/2021	30/11/2021	1/12/2021	2/12/2021	3/12/2021
12	11	6/12/2021	7/12/2021	8/12/2021	9/12/2021	10/12/2021
13	12	13/12/2021	14/12/2021	15/12/2021	16/12/2021	17/12/2021
14	13	20/12/2021	21/12/2021	22/12/2021	23/12/2021	24/12/2021
15	14	27/12/2021	28/12/2021	29/12/2021	30/12/2021	31/12/2021
16	15	3/1/2022	4/1/2022	5/1/2022	6/1/2022	7/1/2022
17	16	10/1/2022	11/1/2022	12/1/2022	13/1/2022	14/1/2022
18	17	17/1/2022	18/1/2022	19/1/2022	20/1/2022	21/1/2022
19	18	24/1/2022	25/1/2022	26/1/2022	27/1/2022	28/1/2022
20	19	31/1/2022	1/2/2022	2/2/2022	3/2/2022	4/2/2022
21	20	7/2/2022	8/2/2022	9/2/2022	10/2/2022	11/2/2022
22	21	14/2/2022	15/2/2022	16/2/2022	17/2/2022	18/2/2022
23	22	21/2/2022	22/2/2022	23/2/2022	24/2/2022	25/2/2022
24	23	28/2/2022	1/3/2022	2/3/2022	3/3/2022	4/3/2022
25	24	7/3/2022	8/3/2022	9/3/2022	10/3/2022	11/3/2022
26	25	14/3/2022	15/3/2022	16/3/2022	17/3/2022	18/3/2022
27	26	21/3/2022	22/3/2022	23/3/2022	24/3/2022	25/3/2022
28	27	28/3/2022	29/3/2022	30/3/2022	31/3/2022	1/4/2022
29	28	4/4/2022	5/4/2022	6/4/2022	7/4/2022	8/4/2022
30	29	11/4/2022	12/4/2022	13/4/2022	14/4/2022	15/4/2022
31	30	18/4/2022	19/4/2022	20/4/2022	21/4/2022	22/4/2022
32	31	25/4/2022	26/4/2022	27/4/2022	28/4/2022	29/4/2022
33	32	2/5/2022	3/5/2022	4/5/2022	5/5/2022	6/5/2022
34	33	9/5/2022	10/5/2022	11/5/2022	12/5/2022	13/5/2022
35	34	16/5/2022	17/5/2022	18/5/2022	19/5/2022	20/5/2022
36	35	23/5/2022	24/5/2022	25/5/2022	26/5/2022	27/5/2022
37	36	30/5/2022	31/5/2022	1/6/2022	2/6/2022	3/6/2022
38	37	6/6/2022	7/6/2022	8/6/2022	9/6/2022	10/6/2022
39	38	13/6/2022	14/6/2022	15/6/2022	16/6/2022	17/6/2022
40	39	20/6/2022	21/6/2022	22/6/2022	23/6/2022	24/6/2022
41	40	27/6/2022	28/6/2022	29/6/2022	30/6/2022	1/7/2022
42	41	4/7/2022	5/7/2022	6/7/2022	7/7/2022	8/7/2022
43	42	11/7/2022	12/7/2022	13/7/2022	14/7/2022	15/7/2022
44	43	18/7/2022	19/7/2022	20/7/2022	21/7/2022	22/7/2022
45	44	25/7/2022	26/7/2022	27/7/2022	28/7/2022	29/7/2022
46	45	1/8/2022	2/8/2022	3/8/2022	4/8/2022	5/8/2022
47	46	8/8/2022	9/8/2022	10/8/2022	11/8/2022	12/8/2022
48	47	15/8/2022	16/8/2022	17/8/2022	18/8/2022	19/8/2022
49	48	22/8/2022	23/8/2022	24/8/2022	25/8/2022	26/8/2022
50	49	29/8/2022	30/8/2022	31/8/2022	1/9/2022	2/9/2022
51	50	5/9/2022	6/9/2022	7/9/2022	8/9/2022	9/9/2022
52	51	12/9/2022	13/9/2022	14/9/2022	15/9/2022	16/9/2022
53	52	19/9/2022	20/9/2022	21/9/2022	22/9/2022	23/9/2022
Sheet2

Cell Formulas
Range	Formula
C2:F53	C2	=B2+1

Sheet 3 is the output that I want the Macro to produce

20210923 - Data Download from Timetabling System.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L
1	Reference	Course Name	Room Number	Location	Allocated Teacher	Delivery Dates	Scheduled Days	Planned Size	Size	Scheduled Start Time	Scheduled End Time	Duration
2	0001	Course 1	23	London	Teacher 1	28/9/2021	Tuesday	0	0	9:00	10:00	01:00
3	0001	Course 1	23	London	Teacher 1	25/10/2021	Tuesday	0	0	9:00	10:00	01:00
4	0001	Course 1	23	London	Teacher 1	16/11/2021	Tuesday	0	0	9:00	10:00	01:00
5	0001	Course 1	23	London	Teacher 1	23/11/2021	Tuesday	0	0	9:00	10:00	01:00
6	0002	Course 2	24	Birmingham	Teacher 2	13/10/2021	Wednesday	0	0	9:00	10:00	01:00
7	0002	Course 2	24	Birmingham	Teacher 2	20/10/2021	Wednesday	0	0	9:00	10:00	01:00
8	0002	Course 2	24	Birmingham	Teacher 2	27/10/2021	Wednesday	0	0	9:00	10:00	01:00
9	0002	Course 2	24	Birmingham	Teacher 2	1/12/2021	Wednesday	0	0	9:00	10:00	01:00
10	0002	Course 2	24	Birmingham	Teacher 2	8/12/2021	Wednesday	0	0	9:00	10:00	01:00
11	0002	Course 2	24	Birmingham	Teacher 2	15/12/2021	Wednesday	0	0	9:00	10:00	01:00
12	0002	Course 2	24	Birmingham	Teacher 2	12/1/2022	Wednesday	0	0	9:00	10:00	01:00
13	0002	Course 2	24	Birmingham	Teacher 2	2/2/2022	Wednesday	0	0	9:00	10:00	01:00
14	0003	Course 3	28	Manchester	Teacher 3	20/1/2022	Thursday	0	0	9:00	10:00	01:00
Sheet 3

So sticking with the Course 2 example above I need the output to reproduce the date on Sheet 1, but to split out each teaching session onto a separate line so each week of teaching has it’s own line. So in this case the lines are:

Week 3 - 13-Oct-21

Week 4 – 20-Oct-21

Week 5 – 27-Oct-21

Week 10 – 1-Dec-21

Week 11 – 8-Dec-21

Week 12 – 15-Dec-21

Week 16 – 12-Jan-22

Week 19 - 2-Feb-22

So COLUMN F contains a date not a week range.

I have to submit this by 9am on Monday and it’s just going to be impossible to split it out manually. Can anyone help with some code to do this?

 

[markster]

OK if it it makes it easier I can change the week ranges to be in the same format i.e. 1, 5, 6, 8, 9, 10, 11, 12, 23, 26 so it's always just a series of numbers rather than a combination of numbers and ranges.

 

[markster]

sometimes it will be just a single number

 

[EXCEL MAX]

You can test this one...

Sub SplitWeekRanges()

    Dim vWS1 As Worksheet, vWS2 As Worksheet, vWS3 As Worksheet
    Dim vA1, vA2(), vA3()
    Dim vS, vSS
    Dim vN As Long, vN1 As Long, vN2 As Long, vN3 As Long
    Dim vR As Long, vNR As Long, vX As Long
    Dim vD As Integer
    Dim vT As String
    
    Set vWS1 = Sheets("Sheet1")
    Set vWS2 = Sheets("Sheet2")
    Set vWS3 = Sheets("Sheet3")
    vR = 1
    vA1 = vWS1.UsedRange
    ReDim vA3(UBound(vA1) - 1)
    ReDim vA2(UBound(vA1) - 1)
    For vN = 2 To UBound(vA1)
        vS = Split(vA1(vN, 6), ",")
        vT = Mid(Replace(SplitWeeks(vS), " ", ""), 2)
        vNR = vNR + UBound(Split(vT, ",")) + 1
        vA2(vN - 1) = vT
    Next vN
    ReDim vA3(1 To vNR + 1, 1 To 12)
    For vN = 2 To UBound(vA1)
        vT = vA1(vN, 7)
        vD = vWS2.Rows(1).Find(vT).Column
        For vN2 = 1 To UBound(Split(vA2(vN - 1), ",")) + 1
            vR = vR + 1
            vT = Application.Index(vWS2.UsedRange, _
                  Split(vA2(vN - 1), ",")(vN2 - 1) + 1, vD)
            For vN3 = 1 To 5
                   vA3(vR, vN3) = vA1(vN, vN3)
            Next vN3
            vA3(vR, 6) = vT
            For vN3 = 7 To 12
                   vA3(vR, vN3) = vA1(vN, vN3)
            Next vN3
        Next
    Next vN
    vWS3.Cells.ClearContents
    vWS3.[A1].Resize(UBound(vA3), 12) = vA3
    With vWS3
        .Range("J2:L" & vNR + 1).NumberFormat = "hh:mm"
        .Range("F2:F" & vNR + 1).NumberFormat = "mm-dd-yy"
        vWS1.[A1:L1].Copy .[A1:L1]
        .[F1] = "Delivery Dates"
    End With
    
End Sub

Function SplitWeeks(ByVal vS)
        
        For vN1 = 0 To UBound(vS)
            If InStr(1, vS(vN1), "-") Then
                vSS = Split(vS(vN1), "-")
                vX = vSS(1) - vSS(0) + 1
                For vN2 = 1 To vX
                    vT = vT & "," & vSS(0) - 1 + vN2
                Next vN2
                GoTo EX
            End If
             vT = vT & "," & vS(vN1)
EX:  Next vN1
        SplitWeeks = vT
        
End Function

 

[markster]

Works perfectly - thanks very much mate. You have saved my Sunday!

 

[EXCEL MAX]

Seems like a nice day to enjoy weekend. Go for it.

 

[markster]

Thanks I just posted another query re identifying clashes in scheduling as having gone through the raw data last night it seems there is quite a few. Thanks for your help and enjoy your Sunday too.
Mark

 

[markster]

Hey mate - thanks for this and thanks to your reply to my other thread that I need to test still. I'm trying this macro and it keeps tripping up at the following point on my real data : vD = vWS2.Rows(1).Find(vT).Column can you confirm what this relates to? I've tried a few things to clean up data but it doesn't work. Thanks very much. Mark

 

[markster]

Mate don't worry it's definitely my data. I need to pinpoint the problem. Cheers and thanks again for everything

 

[DotExcel]

Mate don't worry it's definitely my data. I need to pinpoint the problem. Cheers and thanks again for everything

Hi Mark,

Your error is being generated due to the "scheduled days column". if there is more than one value (i.e. Tuesday, Wednesday...) in column G, it will throw the error that you mention [vD = vWS2.Rows(1).Find(vT).Column].

What is required is another loop of some sort to split the days as well as the ranges. then populate all as separate teaching sessions on sheet 3. the loop will have to allow for all days of the week to extracted since a session could technically be scheduled on Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday.

@EXCEL MAX if you have a solution for this, you will really help me as I am looking for just the same.