Macro to create specific Date format

[ultracyclist]

I want to create a macro that will display the weekly date format as shown in my sample data. I need to carry this down across cell ranges in column A of my worksheet. Ex: A5:A30, A35:A86, and A93:A128. I may need to adjust the ranges but once I see the macro, I can adjust it accordingly.

Additional information- Each week ends on a Friday. For months that have 5 Friday's in them I need it to show a week 5 in those months as shown in my sample data

The data range is 7/7/2017 thru 12/31/2021

Is there a macro that can do this?

Thanks,

Allen

<style type="text/css">
.tg  {border-collapse:collapse;border-spacing:0;}
.tg td{font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;}
.tg th{font-family:Arial, sans-serif;font-size:14px;font-weight:normal;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;}
.tg .tg-yw4l{vertical-align:top}
</style>
[TABLE="class: tg"]

  <tbody>[TR]

    [TH="class: tg-yw4l"]Month 2 Week 1- 8/4/2017[/TH]

  [/TR]

  [TR]

    [TD="class: tg-yw4l"]Week 2- 8/11/2017[/TD]

  [/TR]

  [TR]

    [TD="class: tg-yw4l"]Week 3- 8/18/2017[/TD]

  [/TR]

  [TR]

    [TD="class: tg-yw4l"]Week 4- 8/25/2017[/TD]

  [/TR]

  [TR]

    [TD="class: tg-yw4l"]Month 3 Week 1 -9/1/2017[/TD]

  [/TR]

  [TR]

    [TD="class: tg-yw4l"]Week 2- 9/8/2017[/TD]

  [/TR]

  [TR]

    [TD="class: tg-yw4l"]Week 3- 9/15/2017[/TD]

  [/TR]

  [TR]

    [TD="class: tg-yw4l"]Week 4- 9/22/2017[/TD]

  [/TR]

  [TR]

    [TD="class: tg-yw4l"]Week 5- 9/29/2017[/TD]

  [/TR]

</tbody>[/TABLE]

 

[JLGWhiz]

This is one method to get the text you want in the cells. The For i loop numbers are the integer values of the date range you specified.

Sub WeekLadder()
Dim i As Long, rw As Long, wk As Long, txt As String
    rw = 5
    wk = 1
    For i = 42923 To 43100 Step 7
        If Month(CDate(i)) <> Month(CDate(i - 7)) Then
            wk = 1
            txt = "Month " & Month(CDate(i)) & " Week " & wk & " - " & Format(CDate(i), "mm/dd/yyyy")
            Cells(rw, 1) = txt
            wk = wk + 1
        Else
            txt = "Week " & wk & " - " & Format(CDate(i), "mm/dd/yyyy")
            Cells(rw, 1) = txt
            wk = wk + 1
        End If
        rw = rw + 1
    Next
End Sub

 

[ultracyclist]

Hi,

The macro worked great. What do I need to adjust in the macro to have it run across a greater range of cells so it runs through December 2021? Currently it runs from July 2017 through end of December 2017.

I may need adjust to a shorter time frame, but at least I will have an idea of what to do.

Thank you again

Allen

 

[ultracyclist]

I see in the code the following range. That makes sense 42923 = July. Trying to Google the dates for beyond 2017. If you know of a website where I can find this, I can adjust the code

For i = 42923 To 43100 Step 7

 

[MARK858]

Trying to Google the dates for beyond 2017. If you know of a website where I can find this.

Type the date you want in a cell then format the cell as a number.

 

[ultracyclist]

Thank you for the help. I was just playing around with the date format and forgot about the format cell as a number function.

Mark858 and JLGWhiz thank you both for your help.

 

[JLGWhiz]

Thank you for the help. I was just playing around with the date format and forgot about the format cell as a number function.

Mark858 and JLGWhiz thank you both for your help.

You're welcome, you can also just do this

Sub t()
MsgBox CLng(#12/31/2021#)
End Sub

to get it in VBA. the hash marks are necessary to let VBA know that the numbers are a date literal, otherwise it will look at it as a math entry and error.
Regards, JLG

 

[ultracyclist]

I just noticed something when the code runs. Instead of continuing on with Month 13, Month 14, etc even thought its a new calendar year, the macro starts over with Month 1 for the next calendar year and stops at Month 12. It repeats this process for years 2019 thru 2021.

Is there a way to fix the code so the months increase incrementally until it reaches the last month in the range? I figured it should be somewhere around 55 months approximately from July 2017 thru December 2021.

Thanks,

Allen

 

[JLGWhiz]

See if this does it for you

Sub WeekLadder2()
Dim i As Long, rw As Long, wk As Long, txt As String, mo As Long
    rw = 5
    wk = 1
    For i = 42923 To 43400 Step 7
        If Month(CDate(i)) <> Month(CDate(i - 7)) Then
        mo = mo + 1
            wk = 1
            txt = "Month " & mo & " Week " & wk & " - " & Format(CDate(i), "mm/dd/yyyy")
            Cells(rw, 1) = txt
            wk = wk + 1
        Else
            txt = "Week " & wk & " - " & Format(CDate(i), "mm/dd/yyyy")
            Cells(rw, 1) = txt
            wk = wk + 1
        End If
        rw = rw + 1
    Next
End Sub

 

[ultracyclist]

The revised macro is working perfect. Thank you again for responding to my updated post.