VBA Code to split week ranges into separate lines (additional code required)

[DotExcel]

Hi All,

I refer to the solution in this thread which assumes that the "Day" column will only have one day of the week mentioned i.e. Tuesday.

I am using the same VBA code however, for each activity I could have any number of days mentioned inside this column. currently this code will give me an error if more than one day is mentioned.

I need to develop this code to not only consider the date range for a particular activity but also to split out the days mentioned in the "scheduled days" column.

The scheduled days column could have any number of days of the week (monday to sunday) and is formatted with a comma in between the days and without any spaces as indicated below.

Monday,Tuesday,Wednesday,Thursday,Friday

I imagine I need an extra loop to split these days out similar to the way the week ranges are split and that the loop will need to sit in the correct sequence within the existing code.

really appreciate if somebody can assist with the code as my deadline to get this sorted is running thin.

Here is the code but please visit the thread indicated above for more context if required. The error I get currently is [vD = vWS2.Rows(1).Find(vT).Column].

    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

Edit:
@EXCEL MAX I believe you are the architect of the above code so all credits to you.

Can I ask if you are able to help develop this code as you would already be familiar with the context?

My appreciation in advance