How to compile a list of dates either weekly or monthly between two dates in excel using VBA?

c_dogg

New Member
Joined
May 20, 2021
Messages
3
Office Version
  1. 2016
Platform
  1. Windows
I want to be able to set two dates in excel and then select a drop down box for either "weekly" or "monthly". Then I would like to be able to press a button to run a macro that will fill an excel sheet with every date either weekly or monthly.

I am able to currently generate every date between two dates, but would like to be able to change this depending on a drop down box in excel.

VBA Code:
Sub WriteDates()
'
 Dim sc As Range
 Dim Stdt As Date
 Dim Edt As Date
 Dim dDate As Date
 Dim off As Integer
'
 Stdt = Range("B3") ' start date
 Edt = Range("B4") ' end date
 Set sc = Range("A8") ' start cell
'
 Range("A8").Select
 Range(Selection, Selection.End(xlToRight)).Select
 Selection.ClearContents
'
 off = 0
'

For dDate = Stdt To Edt
      If Format(dDate, "dd") = "01" Then
        sc.Offset(0, off) = Format(dDate, "mmmm yyyy")
        off = off + 1
      End If
Next dDate

'
sc.Resize(off, 1).NumberFormat = "mmmm yyyy"
'
End Sub
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
I would like to try something like this:

VBA Code:
If Range("B5").Value = "Monthly" Then

And for it to accomplish the code above. Or

VBA Code:
If Range("B5").Value = "Weekly" Then

And then for it to accomplish the above, but adding 7 days to the start date in a weekly fashion. I have tried this, but could not get it to work.
 
Upvote 0
Answer below. Although I am pretty sure using
VBA Code:
select
isn't good practice?

VBA Code:
Sub WriteDates()
'
 Dim sc As Range
 Dim Stdt As Date
 Dim Edt As Date
 Dim dDate As Date
 Dim off As Integer
'
 Stdt = Range("B3") ' start date
 Edt = Range("B4") ' end date
 Set sc = Range("A8") ' start cell
'
 Range("A8").Select
 Range(Selection, Selection.End(xlToRight)).Select
 Selection.ClearContents
'
 off = 0
'
NextDate = Stdt

If Range("B5").Value = "Monthly" Then
For dDate = Stdt To Edt
      If Format(dDate, "dd") = "01" Then
        sc.Offset(0, off) = Format(dDate, "mmmm yyyy")
        off = off + 1
      End If
Next dDate

sc.Resize(1, off).NumberFormat = "mmmm yyyy"

Else
If Range("B5").Value = "Weekly" Then

Do Until NextDate > Edt

    ActiveCell.Value = NextDate
    ActiveCell.Offset(0, 1).Select
    NextDate = NextDate + 7

Loop
sc.Resize(1, 10000).NumberFormat = "dd/mm/yy"
End If
End If
'

'
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,214,392
Messages
6,119,255
Members
448,879
Latest member
oksanana

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top