display week ranges based on the start date and end date inputted in two cells

[bleeet]

Hi guys,

To sum of this up is it possible to display date range in weeks based on a start date and end date inputted in two cells.

I built a code where when a user inputs two dates a start date in one cell (say a1) and end date (say b1) the code will display all the dates between those across a certain set of columns. I want to change this so that instead of displaying all the dates it will display the dates in a week range in columns. So if the user inputs a start date is "12/01/2016" and a end date "12/15/2016" the code will populate a week range across columns. So since the week count is 2 in column C would then have "Dec 1 - Dec 8" and column D is "Dec 11- Dec 15"

here is my code to display the days

Dim datez As Date
Dim datez2 As Date
Dim totaldatez As Integer
Dim totaldatez2 As Integer
Dim nwks As Integer




If Cells(6, "g").Value > "" And Cells(6, "h").Value > "" Then


Application.EnableEvents = False


datez = Cells(6, "g").Value
datez2 = Cells(6, "h").Value
totaldatez2 = DateDiff("d", datez, datez2)
nwks = DateDiff("ww", datez, datez2)


totaldatez = DateDiff("d", datez, datez2) + 1
    
    Dim a As Integer
    Dim b As Integer


    
    a = 1


    b = 9


    For a = 1 To totaldatez
    
'        datez = Format(datez, "mm/dd")
        Cells(6, b).Value = datez
        Cells(6, b).NumberFormat = "dd-mmm"
        Cells(6, b).Orientation = xlUpward


        datez = datez + 1
         
        b = b + 1
        
'        Range(Cells(9, a), Cells(10, a)).Interior.ColorIndex = 15
'        Range(Cells(9, a), Cells(10, a)).Borders.ColorIndex = vbBlack
       
        If a = totaldatez Then
            Exit For
        End If








    Next a


ElseIf Cells(4, 1).Value = "" Or Cells(4, 2).Value = "" Then


    Range("i1:z10").Clear
     


End If


Application.EnableEvents = True

 

[pbornemeier]

Not clear on how you want weekends handled. It looks as if the first day in the first block should be the entered date rather than a particular day (e.g. Monday). But Dec 1-8 is an 8-day block and you skipped Dec 9 & 10 which is a Fri-Sat. I am assuming you want 7-day blocks, ignoring weekends and if the last date makes less than a 7-day block the lesser span.

Option Explicit

Sub SheetDates()

    Dim dteFirst As Date
    Dim dteLast As Date
    Dim dteIndex As Long
    Dim lWriteColumn As Long
    Dim lLastRow6Col As Long
    Dim sDateText As String
    Dim bOK As Boolean
    
    'Validate inputs
    bOK = True
    If Not IsDate(Range("G6")) Then bOK = False
    If Not IsDate(Range("H6")) Then bOK = False
    If Range("G6") > Range("H6") Then bOK = False
    
    If bOK Then
    
        Application.EnableEvents = False
        lWriteColumn = 9
        
        'Clear existing output dates
        lLastRow6Col = Cells(6, Columns.Count).End(xlToLeft).Column
        If lLastRow6Col >= lWriteColumn Then
            Range(Cells(6, lWriteColumn), Cells(6, lLastRow6Col)).ClearContents
        End If
        
        dteFirst = Cells(6, "g").Value
        dteLast = Cells(6, "h").Value
    
        For dteIndex = dteFirst To dteLast Step 7
        
            If dteLast - dteIndex = 0 Then
                'Week block is only 1 day (can only happen on last week)
                sDateText = Format(dteIndex, "mmm d")
            ElseIf dteIndex + 6 > dteLast Then
                'Less than 7 days in last block
                sDateText = Format(dteIndex, "mmm d") & " - " & Format(dteLast, "mmm d")
            Else
                '7 days in block
                sDateText = Format(dteIndex, "mmm d") & " - " & Format(dteIndex + 6, "mmm d")
            End If
            Cells(6, lWriteColumn).Orientation = xlUpward
            Cells(6, lWriteColumn).NumberFormat = "@"
            Cells(6, lWriteColumn).Value = sDateText
    
            lWriteColumn = lWriteColumn + 1
            
        Next dteIndex
    
    Else
        MsgBox "Put the Start Date in G6 and the End Date in H6", , "Enter Dates"
        Range("i1:z10").Clear
    End If
    
    
    Application.EnableEvents = True
    
End Sub