Do Until Loop

  • Thread starter Thread starter sgl
  • Start date Start date
S

sgl

I have the following

1 - A Start Date
2 - This Date must be incremented by a certain period (months, quarters,
semi-annualy etc) each time the Loop passes
3 - Need to write the result into a range
4 - "Max range" to write this in is 100 rows (calculated bewteen two ranges
- say A1:A100). loop must stop at 100.

Can someone help write this simple code for me
thanks/sgl
 
Edit the dtStart to suit your requirement. For more about first argument
passed to DATEADD() functionality please refer below

Sub WriteDates()

Dim lngRow As Long
Dim dtStart As Date
Dim dtTemp As Date

dtStart = "04/28/2009"
dtTemp = dtStart
lngRow = 1
Range("A" & lngRow) = dtTemp
Do
lngRow = lngRow + 1
dtTemp = DateAdd("m", 1, dtTemp)
Range("A" & lngRow) = dtTemp
Loop Until lngRow = 100

End Sub


yyyy Year
q Quarter
m Month
y Day of year
d Day
w Weekday
ww Week
h Hour
n Minute
s Second
 
Yes that works very well. Thank you.

Can we please add one more parameter I also have an End Date so whichever
ends first either the range or the End Date

i.e. Start Date 1 Jan 08, End Date 31 Dec 10 and range to write this is 100
rows
if increments are monthly I need only 36 rows and thats where it should stop.

thanks/sgl
 
You can do that.. Please try this

Sub WriteDates()

Dim lngRow As Long
Dim dtStart As Date
Dim dtEnd As Date
Dim dtTemp As Date

dtStart = "01/01/2008"
dtEnd = "12/31/2010"
dtTemp = dtStart
lngRow = 1
Range("A" & lngRow) = dtTemp
Do
lngRow = lngRow + 1
dtTemp = DateAdd("m", 1, dtTemp)
If dtTemp <= dtEnd Then Range("A" & lngRow) = dtTemp
Loop Until lngRow = 100

End Sub
 
A small modification to exit the loop when it reach end date

Sub WriteDates()

Dim lngRow As Long
Dim dtStart As Date
Dim dtEnd As Date
Dim dtTemp As Date

dtStart = "01/01/2008"
dtEnd = "12/31/2010"
dtTemp = dtStart
lngRow = 1
Range("A" & lngRow) = dtTemp
Do
lngRow = lngRow + 1
dtTemp = DateAdd("m", 1, dtTemp)
If dtTemp > dtEnd Then Exit Do
Range("A" & lngRow) = dtTemp
Loop Until lngRow = 100

End Sub

If this post helps click Yes
 
Yes that worked very well thank you vm/sgl

Jacob Skaria said:
A small modification to exit the loop when it reach end date

Sub WriteDates()

Dim lngRow As Long
Dim dtStart As Date
Dim dtEnd As Date
Dim dtTemp As Date

dtStart = "01/01/2008"
dtEnd = "12/31/2010"
dtTemp = dtStart
lngRow = 1
Range("A" & lngRow) = dtTemp
Do
lngRow = lngRow + 1
dtTemp = DateAdd("m", 1, dtTemp)
If dtTemp > dtEnd Then Exit Do
Range("A" & lngRow) = dtTemp
Loop Until lngRow = 100

End Sub

If this post helps click Yes
Click to expand...
 
Back
Top