customizable dates formula

[ndaugherty]

I am trying to build a general course calendar that would work for any course whether it meets 3 days a week, one day a week or last 16 weeks. In order to get the class dates listed in column A, I wanted to see if there was formula that would build this list if there was an input of data like:

Start date of class _________
Days of the week class meets_________
Length of curse in weeks____________

I could create a calendar for each class manually, but I was hoping for a short cut.

Nancy

 

[Joe4]

Welcome to the Board!

Where/how are these three values being input?
Is there any flexibility in how the Days of the week are entered (i.e. can you have a separate cell for each week, indicating Yes/No for each day)?

 

[ndaugherty]

I am open to setting it up however to be able to have the flexibility to create a list of dates that meets their needs. Do you have a suggestion?

 

[Joe4]

OK, I have created a few macros for you. The first one just sets up the structure of the sheet and populate with some sample data:

Sub SetUp()

'   Format sheet
    Range("A1").FormulaR1C1 = "Class Start Date"
    Range("B1").NumberFormat = "m/d/yyyy"
    Range("A2").FormulaR1C1 = "Course Length (in weeks)"
    Range("A5").FormulaR1C1 = "Days to Meet"
    Range("B4").FormulaR1C1 = "Sun"
    Range("C4").FormulaR1C1 = "Mon"
    Range("D4").FormulaR1C1 = "Tue"
    Range("E4").FormulaR1C1 = "Wed"
    Range("F4").FormulaR1C1 = "Thu"
    Range("G4").FormulaR1C1 = "Fri"
    Range("H4").FormulaR1C1 = "Sat"
    With Range("B5:H5").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="Yes,No"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    With Range("B4:H5")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
     With Range("B4:H4")
        .Font.Bold = True
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
    End With
    With Range("B4:H4").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("A7").Select
    ActiveCell.FormulaR1C1 = "Date"
    With Range("A7")
        .Font.Bold = True
        .Font.Underline = xlUnderlineStyleSingle
        .Font.Italic = True
    End With
    Columns("A:A").NumberFormat = "m/d/yyyy"
    Range("A7").FormulaR1C1 = "Dates"
    Cells.EntireColumn.AutoFit
    Columns("B:H").ColumnWidth = 9

'   Enter test data
    Range("B1") = "8/6/2018"
    Range("B2") = "14"
    Range("C5") = "Yes"
    Range("E5") = "Yes"
    Range("G5") = "Yes"
    
End Sub

If you run that first, you will see the set-up.
Now, the second populate the date listing. Run that second.

Sub PopulateDates()

    Dim stDate As Date
    Dim wks As Long
    Dim dys As Long
    Dim d As Long
    Dim newDate As Date
    Dim wkDay As Byte
    
    Application.ScreenUpdating = False
    
'   Get values from sheet
    stDate = Range("B1")
    wks = Range("B2")
    
'   Calculate total number of days in weeks
    dys = wks * 7 - 1
    
'   Loop through all days
    For d = 0 To dys
'       Calculate new date
        newDate = stDate + d
'       Get weekday
        wkDay = Weekday(newDate)
'       If weekday has yes, add new date to list
        If Cells(5, wkDay + 1) = "Yes" Then
            Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = newDate
        End If
    Next d
    
    Application.ScreenUpdating = True
    
End Sub

Is that what you were looking for?

 

[ndaugherty]

Ok I'll give it a try. I have to brush up on macros. Is there a formula that would do the same thing?
Nancy

 

[Joe4]

Ok I'll give it a try. I have to brush up on macros. Is there a formula that would do the same thing?

It would have to be a pretty complex function. And you wouldn't know how many rows you need to copy the formula down for.

You really don't need to know anything about VBA code to run the code that I gave you. Just drop it in a new VBA module and run it.
Here are instructions on how to do that: https://www.ablebits.com/office-addins-blog/2013/12/06/add-run-vba-macro-excel/