VBA Fill Series Weekdays trying to paste same date twice before moving to next date

janki6566 · Oct 25, 2020

Hello,

I have a macro in which I need to fill column BA via a loop with start to end dates and it should only include weekdays. So essentially, my dates can change but for example I have start date of 10/12/2020 to 10/23/2020 but I need them to enter each date twice before moving on to the next date.

VBA Code:

'declaration of variables
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lr1 As Long, lr2 As Long, xLoop As Long
Dim cRow As Integer, rLoop As Integer
Dim sh2 As String, sh5 As String, sh6 As String, sh7 As String, sh8 As String, sh11 As String, sh12 As String, sh13 As String, Sh14 As String, Sh15 As String, sh16 As String
Dim sh1 As Long, i As Long
Dim sh3 As Integer, sh4 As Integer
Dim sh9 As Date, sh10 As Date
Dim shT As String, shR As String


'set worksheet variables
Set ws1 = Sheet1
Set ws2 = Sheet2



'get last row of delivery template
lr1 = ws1.Range("A1048576").End(xlUp).Row

'set last row of manage course offering after clearing
ws2.Range("6:1048576").ClearContents
lr2 = 6

'loop through all rows of delivery template
For xLoop = 3 To lr1

    'set delivery template values into variable
    sh1 = ws1.Range("A" & xLoop).Value 'locator
    sh2 = ws1.Range("B" & xLoop).Value 'course name
    sh3 = ws1.Range("I" & xLoop).Value 'min enr
    sh4 = ws1.Range("J" & xLoop).Value 'max enr
    sh5 = ws1.Range("L" & xLoop).Value 'instructor
    sh6 = ws1.Range("M" & xLoop).Value 'secondary instructor
    sh7 = ws1.Range("N" & xLoop).Value 'T3 instructor
    sh8 = ws1.Range("O" & xLoop).Value 'Primary location
    sh9 = ws1.Range("U" & xLoop).Value 'start date
    sh10 = ws1.Range("W" & xLoop).Value 'end date
    sh11 = ws1.Range("K" & xLoop).Value 'language
    sh12 = ws1.Range("G" & xLoop).Value 'Pricing
    sh13 = ws1.Range("H" & xLoop).Value 'Track Grades
    Sh14 = ws1.Range("V" & xLoop).Value 'start time
    Sh15 = ws1.Range("X" & xLoop).Value 'end time
    sh16 = ws1.Range("E" & xLoop).Value 'LR Start time
    Sh17 = ws1.Range("P" & xLoop).Value 'Room Location
    sh18 = ws1.Range("Q" & xLoop).Value 'Private Onsite Location Address
    sh19 = ws1.Range("R" & xLoop).Value 'Private Onsite Location Room
    sh20 = ws1.Range("S" & xLoop).Value 'Private Onsite Location Time Zone
    sh22 = ws1.Range("C" & xLoop).Value 'LIP or Webinar
    sh23 = ws1.Range("T" & xLoop).Value 'TimeZone for Webinar
    Sh24 = ws1.Range("F" & xLoop).Value 'Pricing Enable
    sh25 = ws1.Range("D" & xLoop).Value 'Teach Type
  
    'custom variable for getting title
    shR = WorksheetFunction.Substitute(sh2, "_", "~", Len(sh2) - Len(Replace(sh2, "_", "")) - 1)
    shT = Replace(Left(shR, InStr(1, shR, "~") - 1), "_", " ")
  
      
        '3. Same date, Start time
       If sh25 = "CoTeach" Then
            With ws2.Range("BA" & lr2)
                .Value = DateValue(sh9) + (Sh14)
                .DataSeries xlColumns, xlChronological, xlWeekday, 1, DateValue(sh10 + 1), False
            End With

The below is a screenshot of what I need my code to do, which is paste each date twice.

My Aswer Is This · Oct 26, 2020

This script looks to be doing a lot more then just entering some dates in a range.
It looks like your dealing with numerous sheets.

I see nothing here that tells the script the start and end dates.

If all you wanted to do was enter some dates in a range why do you need all this code.

Peter_SSs · Oct 26, 2020

My Aswer Is This said:
I see nothing here that tells the script the start and end dates.

It appears to be the setting of variables sh9 and sh10

@janki6566
Firstly a couple of comments.

It is always difficult to debug code when you are only given part of it. Best to post it all if possible but explain where the problem part is.
You need to be careful with your sample data. You describe pasting all dates twice but you have shown 12 Oct and 23 Oct three times each and 13 Oct only once.
Your sample data shows dates only but your code appears to be trying use Date and Time values. You may need to clarify whether you do in fact want Date/Time or just Date.

Assuming that you do want Date/Time try modifying the last part of your displayed code like this.

Rich (BB code):

       If sh25 = "CoTeach" Then
            With ws2.Range("BA" & lr2)
                .Value = DateValue(sh9) + (Sh14)
                .DataSeries xlColumns, xlChronological, xlWeekday, 1, DateValue(sh10 + 1), False
                .Value = sh9 + Sh14
                .DataSeries xlColumns, xlChronological, xlWeekday, 1, sh10 + Sh15, False
            End With
            With ws2.Range("BA" & lr2, ws2.Range("BA" & lr2).End(xlDown))
              .Copy Destination:=.Offset(.Rows.Count)
              .Resize(.Rows.Count * 2).Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
            End With

janki6566 · Oct 26, 2020

Peter_SSs said:
It appears to be the setting of variables sh9 and sh10

@janki6566
Firstly a couple of comments.

It is always difficult to debug code when you are only given part of it. Best to post it all if possible but explain where the problem part is.

You need to be careful with your sample data. You describe pasting all dates twice but you have shown 12 Oct and 23 Oct three times each and 13 Oct only once.

Your sample data shows dates only but your code appears to be trying use Date and Time values. You may need to clarify whether you do in fact want Date/Time or just Date.

Assuming that you do want Date/Time try modifying the last part of your displayed code like this.

Rich (BB code):

If sh25 = "CoTeach" Then With ws2.Range("BA" & lr2) .Value = DateValue(sh9) + (Sh14) .DataSeries xlColumns, xlChronological, xlWeekday, 1, DateValue(sh10 + 1), False .Value = sh9 + Sh14 .DataSeries xlColumns, xlChronological, xlWeekday, 1, sh10 + Sh15, False End With With ws2.Range("BA" & lr2, ws2.Range("BA" & lr2).End(xlDown)) .Copy Destination:=.Offset(.Rows.Count) .Resize(.Rows.Count * 2).Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo End With

Hello ! Thank you again for being so patient with me! My apologies on the sample data. The code is pretty large so I didn't want to over do it. Again, sorry!

I tried this code and its close but I am running into a couple of issues and I am not sure what route to take. I have tried a variation of things and just don't seem to get it to that point.

I will paste here in a bit the entire code but essentially the code is pulling from worksheet 1 the date and time value which I fixed into on cell. Then it its is meant to run through a loop in which if the teach type is Co-Teach, then the number of days between the start date and end date should be represented twice so essentially a 10 day class would have 20 rows of data, then dates are suppose to repeat twice as shown above and yes you are correct my sample data for date 10/23/2020 should have only been done twice.

I tested the code provide and it takes the last day and run through twice instead of each date. Here is what I am getting:

In an attempt to run through it and try to change the code, I tried changing the Resize (.Row.Count*2) to Resize (.Row.Count *.5) and it did this and errored.

I tried many other variations that also errored, I am just not sure where I am going wrong. In effort, I have pasted my entire code but we are focusing on section 3 for time

VBA Code:

declaration of variables
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lr1 As Long, lr2 As Long, xLoop As Long
Dim cRow As Integer, rLoop As Integer
Dim sh2 As String, sh5 As String, sh6 As String, sh7 As String, sh8 As String, sh11 As String, sh12 As String, sh13 As String, Sh14 As String, Sh15 As String, sh16 As String
Dim sh1 As Long, i As Long
Dim sh3 As Integer, sh4 As Integer
Dim sh9 As Date, sh10 As Date
Dim shT As String, shR As String

'set worksheet variables
Set ws1 = Sheet1
Set ws2 = Sheet2



'get last row of delivery template
lr1 = ws1.Range("A1048576").End(xlUp).Row

'set last row of manage course offering after clearing
ws2.Range("6:1048576").ClearContents
lr2 = 6

'loop through all rows of delivery template
For xLoop = 3 To lr1

    'set delivery template values into variable
    sh1 = ws1.Range("A" & xLoop).Value 'locator
    sh2 = ws1.Range("B" & xLoop).Value 'course name
    sh3 = ws1.Range("I" & xLoop).Value 'min enr
    sh4 = ws1.Range("J" & xLoop).Value 'max enr
    sh5 = ws1.Range("L" & xLoop).Value 'instructor
    sh6 = ws1.Range("M" & xLoop).Value 'secondary instructor
    sh7 = ws1.Range("N" & xLoop).Value 'T3 instructor
    sh8 = ws1.Range("O" & xLoop).Value 'Primary location
    sh9 = ws1.Range("U" & xLoop).Value 'start date
    sh10 = ws1.Range("X" & xLoop).Value 'end date
    sh11 = ws1.Range("K" & xLoop).Value 'language
    sh12 = ws1.Range("G" & xLoop).Value 'Pricing
    sh13 = ws1.Range("H" & xLoop).Value 'Track Grades
    Sh14 = ws1.Range("V" & xLoop).Value 'start time
    Sh15 = ws1.Range("X" & xLoop).Value 'end time
    sh16 = ws1.Range("E" & xLoop).Value 'LR Start time
    Sh17 = ws1.Range("P" & xLoop).Value 'Room Location
    sh18 = ws1.Range("Q" & xLoop).Value 'Private Onsite Location Address
    sh19 = ws1.Range("R" & xLoop).Value 'Private Onsite Location Room
    sh20 = ws1.Range("S" & xLoop).Value 'Private Onsite Location Time Zone
    sh22 = ws1.Range("C" & xLoop).Value 'LIP or Webinar
    sh23 = ws1.Range("T" & xLoop).Value 'TimeZone for Webinar
    Sh24 = ws1.Range("F" & xLoop).Value 'Pricing Enable
    Sh25 = ws1.Range("D" & xLoop).Value 'Teach Type
    
    'custom variable for getting title
    shR = WorksheetFunction.Substitute(sh2, "_", "~", Len(sh2) - Len(Replace(sh2, "_", "")) - 1)
    shT = Replace(Left(shR, InStr(1, shR, "~") - 1), "_", " ")
    
    
'LIP courses
If sh22 = "LIP" Then
    
    'number of instances
    If (Sh25 = "Regular" Or Sh25 = "Onsite") Then
        cRow = (Application.WorksheetFunction.NetworkDays_Intl(sh9, sh10, 1))
    ElseIf Sh25 = "CoTeach" Then
            cRow = (Application.WorksheetFunction.NetworkDays_Intl(sh9, sh10, 1)) * 2
    ElseIf Sh25 = "T3" Then
        cRow = (Application.WorksheetFunction.NetworkDays_Intl(sh9, sh10, 1)) + 1
    End If

    
    'loop to place values
    For rLoop = 0 To cRow - 1
    
        '1. days display vertically LIP
        If Sh25 = "T3" And rLoop = cRow - 1 Then
           ws2.Range("AO" & rLoop + lr2).Value = rLoop
           ws2.Range("AQ" & rLoop + lr2).Value = rLoop
        Else
           ws2.Range("AO" & rLoop + lr2).Value = rLoop + 1
           ws2.Range("AQ" & rLoop + lr2).Value = rLoop + 1
        End If


        
        '2. title and day
         If Sh25 = "CoTeach" Then
           ws2.Range("AS" & rLoop + lr2).Value = shT & "- Day" & Application.WorksheetFunction.RoundUp((rLoop + 1) / 2, 0)
         Else
           If Sh25 = "T3" And rLoop = cRow - 1 Then ' added 10/19/2001 if on the last row
              ws2.Range("AS" & rLoop + lr2).Value = shT & "- Day" & rLoop
           Else
               ws2.Range("AS" & rLoop + lr2).Value = shT & "- Day" & rLoop + 1
           End If
        End If
  '3. Same date, Start time
       If Sh25 = "CoTeach" Then
                With ws2.Range("BA" & lr2)
                    .Value = DateValue(sh9) + TimeValue(sh9)
                    .DataSeries xlColumns, xlChronological, xlWeekday, 1, DateValue(sh10) + TimeValue(sh9), False
                End With
                With ws2.Range("BB" & lr2)
                    .Value = DateValue(sh9) + TimeValue(sh10)
                    .DataSeries xlColumns, xlChronological, xlWeekday, 1, DateValue(sh10) + TimeValue(sh10), False
                 End With
                With ws2.Range("BA" & lr2, ws2.Range("BA" & lr2)).End((xlDown))
                    .Copy Destination:=.Offset(.Rows.Count)
                    .Resize(.Rows.Count * 0.5).Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
                 End With
                With ws2.Range("BB" & lr2, ws2.Range("BB" & lr2)).End((xlDown))
                    .Copy Destination:=.Offset(.Rows.Count)
                    .Resize(.Rows.Count * 2).Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
                 End With
        Else
            If Sh25 = "T3" And rLoop = cRow - 1 Then
                 With ws2.Range("BA" & lr2)
                    .Value = DateValue(sh9) + TimeValue(sh9)
                    .DataSeries xlColumns, xlChronological, xlWeekday, 1, DateValue(sh10) + TimeValue(sh9), False
                    ws2.Range("BA" & cRow + lr2 - 1).Value = DateValue(sh10) + TimeValue(sh9)
                 End With
                  With ws2.Range("BB" & lr2)
                    .Value = DateValue(sh9) + TimeValue(sh10)
                    .DataSeries xlColumns, xlChronological, xlWeekday, 1, DateValue(sh10) + TimeValue(sh10), False
                    ws2.Range("BB" & cRow + lr2 - 1).Value = DateValue(sh10) + TimeValue(sh10)
                 End With
            Else
                With ws2.Range("BA" & lr2)
                    .Value = DateValue(sh9) + TimeValue(sh9)
                    .DataSeries xlColumns, xlChronological, xlWeekday, 1, DateValue(sh10) + TimeValue(sh9), False
                 End With
                With ws2.Range("BB" & lr2)
                    .Value = DateValue(sh9) + TimeValue(sh10)
                    .DataSeries xlColumns, xlChronological, xlWeekday, 1, DateValue(sh10) + TimeValue(sh10), False
                 End With
            End If
        End If
 

          

         '3.1 LR Start Time
         If sh16 = "Yes" Then
            ws2.Range("BA" & lr2).Value = (sh9) + ("8:30 am")
            End If
            
            
        '4. Static values
        ws2.Range("F" & rLoop + lr2).Value = 1
        ws2.Range("AR" & rLoop + lr2).Value = "Y"
        ws2.Range("BC" & rLoop + lr2).Value = "Y"
        
        '5. Exam only if Services
        If sh13 = "Yes" Then
            ws2.Range("BD" & rLoop + lr2).Value = "Y"
            ws2.Range("BE" & rLoop + lr2).Value = "Pass/Fail"
            ws2.Range("BR" & lr2 + cRow + 1).Value = "https://ondemand.questionmark.com/home/405715/"
            ws2.Range("BS" & lr2 + cRow + 1).Value = "Multiple Choice Exam"
            ws2.Range("BT" & lr2 + cRow + 1).Value = "Exam"
        End If
        
        '6. Repeat to all rows in column AU and AP
       If (Sh25 = "Regular" Or Sh25 = "Onsite") Then
            ws2.Range("AU" & rLoop + lr2).Value = get_id(sh5)
        ElseIf Sh25 = "CoTeach" Then ' alternate outputting the primary and secondary instructors
                If Application.WorksheetFunction.IsEven(rLoop) Then
                    ws2.Range("AU" & rLoop + lr2).Value = get_id(sh5)
                Else
                    ws2.Range("AU" & rLoop + lr2).Value = get_id(sh6)
                End If
        ElseIf Sh25 = "T3" And rLoop = cRow - 1 Then ' added 10/19/2001
                ws2.Range("AU" & rLoop + lr2).Value = get_id(sh5) 'output the T3 instructor
            Else
                ws2.Range("AU" & rLoop + lr2).Value = get_id(sh7) ' output the T3 instructor from column P
        End If
        
        '6.1 Get room location
        If (Sh25 = "Regular" Or Sh25 = "CoTeach") Then
            ws2.Range("AV" & rLoop + lr2).Value = Sh17
        Else
            ws2.Range("AW" & rLoop + lr2).Value = "Private Onsite"
            ws2.Range("AX" & rLoop + lr2).Value = sh18
            ws2.Range("AY" & rLoop + lr2).Value = sh19
            ws2.Range("AZ" & rLoop + lr2).Value = sh20
        End If
Next rLoop

    'Courses with an exam get an extra row
    If sh13 = "Yes" Then
        vCounter = 1
    Else
        vCounter = 0
    End If
    'Numbering of unique entries (per row)
    For rLoop = 0 To cRow + vCounter
         ws2.Range("B" & rLoop + lr2).Value = xLoop - 2
         ws2.Range("F" & rLoop + lr2).Value = 1
         ws2.Range("AO" & rLoop + lr2).Value = rLoop + 1
         ws2.Range("AQ" & rLoop + lr2).Value = rLoop + 1
    Next rLoop
    
    '7. Course Title to 1st instance of row
    ws2.Range("E" & lr2).Value = sh2
    
    '8. Offering number in 1st row only
    ws2.Range("G" & lr2).Value = sh1
    ws2.Range("D" & lr2).Value = sh1
    
    '9. Static values in first row only
    ws2.Range("I" & lr2).Value = "Y"
    ws2.Range("M" & lr2).Value = "N"
    ws2.Range("N" & lr2).Value = 0
    ws2.Range("O" & lr2).Value = "N"
    
    '10. Min Enroll Capacity on 1st row only
    ws2.Range("K" & lr2).Value = sh3
    
    '11. Max Enroll Capacity on 1st row only
    ws2.Range("L" & lr2).Value = sh4
    
    '12. Employee ID of E, first row only
    If sh5 <> "" Then ws2.Range("AG" & lr2).Value = get_id(sh5)
    
    
    '13.Language code, 1st row only
    If sh11 <> "" Then ws2.Range("Y" & lr2).Value = get_language(sh11)
    
    '13. Primary Location, first row only
    ws2.Range("AI" & lr2).Value = sh8
    
    '13.1 Pricing enabled
    ws2.Range("Z" & lr2).Value = Sh24
    ws2.Range("AA" & lr2).Value = sh12
    
   '14. Add last row for evaluation
    ws2.Range("BW" & lr2 + cRow).Value = "Media-6-13657"
    ws2.Range("BX" & lr2 + cRow).Value = "LIP/LV/LR Evaluation"
    ws2.Range("BY" & lr2 + cRow).Value = "Evaluation"


    'get next batch of row for fill
    If sh13 = "No" Then
        lr2 = lr2 + cRow + 1
    ElseIf sh13 = "Yes" Then
        lr2 = lr2 + cRow + 2
    End If

any help would be greatly appreciated!

My Aswer Is This · Oct 26, 2020

Just a comment from me.
I prefer users tell me with specifics what they want accomplished and let me write the code.
Showing me a hundred lines of your code does not help me much it drains my brain trying to read all the code and sort out what needs to be changed since the code the user is using does not work for the user.

When I say specifics I mean:
Column numbers like column B
Sheet names like sheet named "Alpha"
Do not say column Dates or Sheet(1)

Just my thoughts.

janki6566 · Oct 26, 2020

janki6566 said:

Hello ! Thank you again for being so patient with me! My apologies on the sample data. The code is pretty large so I didn't want to over do it. Again, sorry!

I tried this code and its close but I am running into a couple of issues and I am not sure what route to take. I have tried a variation of things and just don't seem to get it to that point.

I will paste here in a bit the entire code but essentially the code is pulling from worksheet 1 the date and time value which I fixed into on cell. Then it its is meant to run through a loop in which if the teach type is Co-Teach, then the number of days between the start date and end date should be represented twice so essentially a 10 day class would have 20 rows of data, then dates are suppose to repeat twice as shown above and yes you are correct my sample data for date 10/23/2020 should have only been done twice.

I tested the code provide and it takes the last day and run through twice instead of each date. Here is what I am getting:

View attachment 24938

In an attempt to run through it and try to change the code, I tried changing the Resize (.Row.Count*2) to Resize (.Row.Count *.5) and it did this and errored.
View attachment 24939

I tried many other variations that also errored, I am just not sure where I am going wrong. In effort, I have pasted my entire code but we are focusing on section 3 for time

VBA Code:

declaration of variables
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lr1 As Long, lr2 As Long, xLoop As Long
Dim cRow As Integer, rLoop As Integer
Dim sh2 As String, sh5 As String, sh6 As String, sh7 As String, sh8 As String, sh11 As String, sh12 As String, sh13 As String, Sh14 As String, Sh15 As String, sh16 As String
Dim sh1 As Long, i As Long
Dim sh3 As Integer, sh4 As Integer
Dim sh9 As Date, sh10 As Date
Dim shT As String, shR As String

'set worksheet variables
Set ws1 = Sheet1
Set ws2 = Sheet2



'get last row of delivery template
lr1 = ws1.Range("A1048576").End(xlUp).Row

'set last row of manage course offering after clearing
ws2.Range("6:1048576").ClearContents
lr2 = 6

'loop through all rows of delivery template
For xLoop = 3 To lr1

    'set delivery template values into variable
    sh1 = ws1.Range("A" & xLoop).Value 'locator
    sh2 = ws1.Range("B" & xLoop).Value 'course name
    sh3 = ws1.Range("I" & xLoop).Value 'min enr
    sh4 = ws1.Range("J" & xLoop).Value 'max enr
    sh5 = ws1.Range("L" & xLoop).Value 'instructor
    sh6 = ws1.Range("M" & xLoop).Value 'secondary instructor
    sh7 = ws1.Range("N" & xLoop).Value 'T3 instructor
    sh8 = ws1.Range("O" & xLoop).Value 'Primary location
    sh9 = ws1.Range("U" & xLoop).Value 'start date
    sh10 = ws1.Range("X" & xLoop).Value 'end date
    sh11 = ws1.Range("K" & xLoop).Value 'language
    sh12 = ws1.Range("G" & xLoop).Value 'Pricing
    sh13 = ws1.Range("H" & xLoop).Value 'Track Grades
    Sh14 = ws1.Range("V" & xLoop).Value 'start time
    Sh15 = ws1.Range("X" & xLoop).Value 'end time
    sh16 = ws1.Range("E" & xLoop).Value 'LR Start time
    Sh17 = ws1.Range("P" & xLoop).Value 'Room Location
    sh18 = ws1.Range("Q" & xLoop).Value 'Private Onsite Location Address
    sh19 = ws1.Range("R" & xLoop).Value 'Private Onsite Location Room
    sh20 = ws1.Range("S" & xLoop).Value 'Private Onsite Location Time Zone
    sh22 = ws1.Range("C" & xLoop).Value 'LIP or Webinar
    sh23 = ws1.Range("T" & xLoop).Value 'TimeZone for Webinar
    Sh24 = ws1.Range("F" & xLoop).Value 'Pricing Enable
    Sh25 = ws1.Range("D" & xLoop).Value 'Teach Type
   
    'custom variable for getting title
    shR = WorksheetFunction.Substitute(sh2, "_", "~", Len(sh2) - Len(Replace(sh2, "_", "")) - 1)
    shT = Replace(Left(shR, InStr(1, shR, "~") - 1), "_", " ")
   
   
'LIP courses
If sh22 = "LIP" Then
   
    'number of instances
    If (Sh25 = "Regular" Or Sh25 = "Onsite") Then
        cRow = (Application.WorksheetFunction.NetworkDays_Intl(sh9, sh10, 1))
    ElseIf Sh25 = "CoTeach" Then
            cRow = (Application.WorksheetFunction.NetworkDays_Intl(sh9, sh10, 1)) * 2
    ElseIf Sh25 = "T3" Then
        cRow = (Application.WorksheetFunction.NetworkDays_Intl(sh9, sh10, 1)) + 1
    End If

   
    'loop to place values
    For rLoop = 0 To cRow - 1
   
        '1. days display vertically LIP
        If Sh25 = "T3" And rLoop = cRow - 1 Then
           ws2.Range("AO" & rLoop + lr2).Value = rLoop
           ws2.Range("AQ" & rLoop + lr2).Value = rLoop
        Else
           ws2.Range("AO" & rLoop + lr2).Value = rLoop + 1
           ws2.Range("AQ" & rLoop + lr2).Value = rLoop + 1
        End If


       
        '2. title and day
         If Sh25 = "CoTeach" Then
           ws2.Range("AS" & rLoop + lr2).Value = shT & "- Day" & Application.WorksheetFunction.RoundUp((rLoop + 1) / 2, 0)
         Else
           If Sh25 = "T3" And rLoop = cRow - 1 Then ' added 10/19/2001 if on the last row
              ws2.Range("AS" & rLoop + lr2).Value = shT & "- Day" & rLoop
           Else
               ws2.Range("AS" & rLoop + lr2).Value = shT & "- Day" & rLoop + 1
           End If
        End If
  '3. Same date, Start time
       If Sh25 = "CoTeach" Then
                With ws2.Range("BA" & lr2)
                    .Value = DateValue(sh9) + TimeValue(sh9)
                    .DataSeries xlColumns, xlChronological, xlWeekday, 1, DateValue(sh10) + TimeValue(sh9), False
                End With
                With ws2.Range("BB" & lr2)
                    .Value = DateValue(sh9) + TimeValue(sh10)
                    .DataSeries xlColumns, xlChronological, xlWeekday, 1, DateValue(sh10) + TimeValue(sh10), False
                 End With
                With ws2.Range("BA" & lr2, ws2.Range("BA" & lr2)).End((xlDown))
                    .Copy Destination:=.Offset(.Rows.Count)
                    .Resize(.Rows.Count * 0.5).Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
                 End With
                With ws2.Range("BB" & lr2, ws2.Range("BB" & lr2)).End((xlDown))
                    .Copy Destination:=.Offset(.Rows.Count)
                    .Resize(.Rows.Count * 2).Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
                 End With
        Else
            If Sh25 = "T3" And rLoop = cRow - 1 Then
                 With ws2.Range("BA" & lr2)
                    .Value = DateValue(sh9) + TimeValue(sh9)
                    .DataSeries xlColumns, xlChronological, xlWeekday, 1, DateValue(sh10) + TimeValue(sh9), False
                    ws2.Range("BA" & cRow + lr2 - 1).Value = DateValue(sh10) + TimeValue(sh9)
                 End With
                  With ws2.Range("BB" & lr2)
                    .Value = DateValue(sh9) + TimeValue(sh10)
                    .DataSeries xlColumns, xlChronological, xlWeekday, 1, DateValue(sh10) + TimeValue(sh10), False
                    ws2.Range("BB" & cRow + lr2 - 1).Value = DateValue(sh10) + TimeValue(sh10)
                 End With
            Else
                With ws2.Range("BA" & lr2)
                    .Value = DateValue(sh9) + TimeValue(sh9)
                    .DataSeries xlColumns, xlChronological, xlWeekday, 1, DateValue(sh10) + TimeValue(sh9), False
                 End With
                With ws2.Range("BB" & lr2)
                    .Value = DateValue(sh9) + TimeValue(sh10)
                    .DataSeries xlColumns, xlChronological, xlWeekday, 1, DateValue(sh10) + TimeValue(sh10), False
                 End With
            End If
        End If


         

         '3.1 LR Start Time
         If sh16 = "Yes" Then
            ws2.Range("BA" & lr2).Value = (sh9) + ("8:30 am")
            End If
           
           
        '4. Static values
        ws2.Range("F" & rLoop + lr2).Value = 1
        ws2.Range("AR" & rLoop + lr2).Value = "Y"
        ws2.Range("BC" & rLoop + lr2).Value = "Y"
       
        '5. Exam only if Services
        If sh13 = "Yes" Then
            ws2.Range("BD" & rLoop + lr2).Value = "Y"
            ws2.Range("BE" & rLoop + lr2).Value = "Pass/Fail"
            ws2.Range("BR" & lr2 + cRow + 1).Value = "https://ondemand.questionmark.com/home/405715/"
            ws2.Range("BS" & lr2 + cRow + 1).Value = "Multiple Choice Exam"
            ws2.Range("BT" & lr2 + cRow + 1).Value = "Exam"
        End If
       
        '6. Repeat to all rows in column AU and AP
       If (Sh25 = "Regular" Or Sh25 = "Onsite") Then
            ws2.Range("AU" & rLoop + lr2).Value = get_id(sh5)
        ElseIf Sh25 = "CoTeach" Then ' alternate outputting the primary and secondary instructors
                If Application.WorksheetFunction.IsEven(rLoop) Then
                    ws2.Range("AU" & rLoop + lr2).Value = get_id(sh5)
                Else
                    ws2.Range("AU" & rLoop + lr2).Value = get_id(sh6)
                End If
        ElseIf Sh25 = "T3" And rLoop = cRow - 1 Then ' added 10/19/2001
                ws2.Range("AU" & rLoop + lr2).Value = get_id(sh5) 'output the T3 instructor
            Else
                ws2.Range("AU" & rLoop + lr2).Value = get_id(sh7) ' output the T3 instructor from column P
        End If
       
        '6.1 Get room location
        If (Sh25 = "Regular" Or Sh25 = "CoTeach") Then
            ws2.Range("AV" & rLoop + lr2).Value = Sh17
        Else
            ws2.Range("AW" & rLoop + lr2).Value = "Private Onsite"
            ws2.Range("AX" & rLoop + lr2).Value = sh18
            ws2.Range("AY" & rLoop + lr2).Value = sh19
            ws2.Range("AZ" & rLoop + lr2).Value = sh20
        End If
Next rLoop

    'Courses with an exam get an extra row
    If sh13 = "Yes" Then
        vCounter = 1
    Else
        vCounter = 0
    End If
    'Numbering of unique entries (per row)
    For rLoop = 0 To cRow + vCounter
         ws2.Range("B" & rLoop + lr2).Value = xLoop - 2
         ws2.Range("F" & rLoop + lr2).Value = 1
         ws2.Range("AO" & rLoop + lr2).Value = rLoop + 1
         ws2.Range("AQ" & rLoop + lr2).Value = rLoop + 1
    Next rLoop
   
    '7. Course Title to 1st instance of row
    ws2.Range("E" & lr2).Value = sh2
   
    '8. Offering number in 1st row only
    ws2.Range("G" & lr2).Value = sh1
    ws2.Range("D" & lr2).Value = sh1
   
    '9. Static values in first row only
    ws2.Range("I" & lr2).Value = "Y"
    ws2.Range("M" & lr2).Value = "N"
    ws2.Range("N" & lr2).Value = 0
    ws2.Range("O" & lr2).Value = "N"
   
    '10. Min Enroll Capacity on 1st row only
    ws2.Range("K" & lr2).Value = sh3
   
    '11. Max Enroll Capacity on 1st row only
    ws2.Range("L" & lr2).Value = sh4
   
    '12. Employee ID of E, first row only
    If sh5 <> "" Then ws2.Range("AG" & lr2).Value = get_id(sh5)
   
   
    '13.Language code, 1st row only
    If sh11 <> "" Then ws2.Range("Y" & lr2).Value = get_language(sh11)
   
    '13. Primary Location, first row only
    ws2.Range("AI" & lr2).Value = sh8
   
    '13.1 Pricing enabled
    ws2.Range("Z" & lr2).Value = Sh24
    ws2.Range("AA" & lr2).Value = sh12
   
   '14. Add last row for evaluation
    ws2.Range("BW" & lr2 + cRow).Value = "Media-6-13657"
    ws2.Range("BX" & lr2 + cRow).Value = "LIP/LV/LR Evaluation"
    ws2.Range("BY" & lr2 + cRow).Value = "Evaluation"


    'get next batch of row for fill
    If sh13 = "No" Then
        lr2 = lr2 + cRow + 1
    ElseIf sh13 = "Yes" Then
        lr2 = lr2 + cRow + 2
    End If

any help would be greatly appreciated!

And only need help in the section for section 3 for the IF sh25 = "CoTeach" then section, anything after If sh25 ="t3" is good. Thank you so much for any guidance you can provide.

Peter_SSs · Oct 27, 2020

So that I can be fairly sure I am using similar data ...
Let's assume

xLoop = 3 so we are looking in row 3 on ws1
Sh25 = "CoTeach"

Given that, can you answer the following questions about ws1?

What is in cell U3 and is it text or numerical? If unsure what does this formula return? =ISNUMBER(U3)
What is in cell X3 and is it text or numerical?

Can I also suggest that you investigate XL2BB for providing (small) sample data to make it easier for helpers by not having to manually type out sample data to test with.

janki6566 · Oct 27, 2020

Peter_SSs said:
So that I can be fairly sure I am using similar data ...
Let's assume

xLoop = 3 so we are looking in row 3 on ws1

Sh25 = "CoTeach"

Given that, can you answer the following questions about ws1?

What is in cell U3 and is it text or numerical? If unsure what does this formula return? =ISNUMBER(U3)

What is in cell X3 and is it text or numerical?

Peter_SSs said:
So that I can be fairly sure I am using similar data ...
Let's assume

xLoop = 3 so we are looking in row 3 on ws1

Sh25 = "CoTeach"

Given that, can you answer the following questions about ws1?

What is in cell U3 and is it text or numerical? If unsure what does this formula return? =ISNUMBER(U3)

What is in cell X3 and is it text or numerical?

Can I also suggest that you investigate XL2BB for providing (small) sample data to make it easier for helpers by not having to manually type out sample data to test with.

Hello

Yes, the assumptions are correct.

answer for ws1
1 and 2: no its formula that makes a date and time value from two other columns

trying the xxlb here where the dates are pulling from

Course Offering - Copy.xlsm

U

V

W

X

Y

Z

1

Start Date*

End Date*

2

Start

Date of class start

Time of class start

End Date*

Date of class end

Time of class end

3

10/12/20 9:00:00

10/12/2020

9:00:00 AM

10/22/20 14:00:00

10/22/2020

2:00:00 PM

4

10/12/20 9:00:00

10/12/2020

9:00:00 AM

10/22/20 14:00:00

10/22/2020

2:00:00 PM

5

10/12/20 9:00:00

10/12/2020

9:00:00 AM

10/23/20 14:00:00

10/23/2020

2:00:00 PM

6

10/12/20 9:00:00

10/12/2020

9:00:00 AM

10/23/20 14:00:00

10/23/2020

2:00:00 PM

Delivery Template

Cell Formulas
Range	Formula
U3:U6,X3:X6	U3	=TEXT(V3,"m/dd/yy ")&TEXT(W3,"h:mm:ss")

janki6566 · Oct 27, 2020

janki6566 said:
Hello

Yes, the assumptions are correct.

answer for ws1
1 and 2: no its formula that makes a date and time value from two other columns

trying the xxlb here where the dates are pulling from

Course Offering - Copy.xlsm
U V W X Y Z
1 Start Date* End Date* End Date*
2 Start Date of class start Time of class start End Date* Date of class end Time of class end
3 10/12/20 9:00:00 10/12/2020 9:00:00 AM 10/22/20 14:00:00 10/22/2020 2:00:00 PM
4 10/12/20 9:00:00 10/12/2020 9:00:00 AM 10/22/20 14:00:00 10/22/2020 2:00:00 PM
5 10/12/20 9:00:00 10/12/2020 9:00:00 AM 10/23/20 14:00:00 10/23/2020 2:00:00 PM
6 10/12/20 9:00:00 10/12/2020 9:00:00 AM 10/23/20 14:00:00 10/23/2020 2:00:00 PM
Delivery Template
Cell Formulas
Range Formula
U3:U6,X3:X6 U3 =TEXT(V3,"m/dd/yy ")&TEXT(W3,"h:mm:ss")

Let me clarify xLoop starts at row 3 ws1 and loops through each line to create a set of data in ws2. If there was a way to send you a attachment and thats easier. let me know.

janki6566 · Oct 27, 2020

Just a heads up, I figured this out with following code, but thank you so much for your help!!!! Peter_SS you are so awesome!!!

VBA Code:

  If sh25 = "CoTeach" Then
           If Application.WorksheetFunction.IsEven(rLoop + 2) Then
                MyCount = Application.WorksheetFunction.RoundDown((rLoop + 1) / 2, 0)
                With ws2.Range("BA" & rLoop + lr2)
                    
                    MyWeekDay = Weekday(DateValue(sh9 + MyCount) + TimeValue(sh9))
                    If MyWeekDay >= 2 And MyWeekDay <= 6 Then
                        If AreWeInWeek2 = False Then
                           .Value = DateValue(sh9 + MyCount) + TimeValue(sh9)
                        Else
                            
                           .Value = DateValue(sh9 + MyCount + 2) + TimeValue(sh9)
                        End If

                    Else
                        ' the day is either Saturday or Sunday
                        .Value = DateValue(sh9 + MyCount + 2) + TimeValue(sh9)
                        If MyWeekDay = 7 Then
                            AreWeInWeek2 = True
                        End If
                    End If

VBA Fill Series Weekdays trying to paste same date twice before moving to next date

janki6566

New Member

Excel Facts

My Aswer Is This

Well-known Member

Peter_SSs

MrExcel MVP, Moderator

janki6566

New Member

My Aswer Is This

Well-known Member

janki6566

New Member

Peter_SSs

MrExcel MVP, Moderator

janki6566

New Member

janki6566

New Member

janki6566

New Member

Similar threads

Forum statistics

Share this page

VBA Fill Series Weekdays trying to paste same date twice before moving to next date

New Member

Excel Facts

Well-known Member

MrExcel MVP, Moderator

New Member

Well-known Member

New Member

MrExcel MVP, Moderator

New Member

New Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock