Trigger inserting date

R

Ricky

I have a a workbook of monthly data for every 3 hours of each day. In
column A I have a date entry, i.e. 8 rows with "1 Jan 09", and the next
8 rows will have "2 Jan 09" all the way down to the last day of the
month. So with a 31 day month, cells A240 to A248

Could someone suggest a macro that would automatically populate cells A2
down to A248 with dates, once "1 Jan 09" is entered into A1?
 
J

Jacob Skaria

Sub Macro1()
Dim dtStart
Dim lngRow
Dim intTemp

lngRow = 2
For dtStart = Range("A1") To Range("A1") + 30
If Month(dtStart) <> Month(Range("A1")) Then Exit Sub
For intTemp = 1 To 8
If lngRow = 2 Then intTemp = intTemp + 1
Range("A" & lngRow) = dtStart
lngRow = lngRow + 1
Next
Next
End Sub
 
J

Jacob Skaria

If you are new to macros Set the Security level to low/medium in
(Tools|Macro|Security). 'Launch VBE using short-key Alt+F11. Insert a module
and paste the below code. Save. Get back to Workbook. Tools|Macro|Run Macro()

If this post helps click Yes
 
R

Rick Rothstein

Here is another macro for you to consider...

Sub FillDatesEightTimesEach()
Dim X As Long
For X = 1 To 8 * Day(DateAdd("m", 1, Range("A1").Text) - 1) Step 8
Cells(X, "A").Resize(8, 1).Value = Range("A1").Value + Int(X / 8)
Next
End Sub
 
R

Ricky

Thanks so much Jacob and Rick.

Can I get the macro to run automatically directly upon entering a date
in A1 at all?
 
R

Rick Rothstein

Yes, we can do it automatically. The code must go in the worksheet's code
window. To get there, right click the worksheet's tab and select View Code
from the menu that pops up, then copy/paste the following into the code
window that appeared...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim X As Long
If Target.Address = "$A$1" And IsDate(Target.Value) Then
Range("A2:A248").Clear
If Day(Target.Value) = 1 Then
For X = 1 To 8 * Day(DateAdd("m", 1, Range("A1").Text) - 1) Step 8
Cells(X, "A").Resize(8, 1).Value = Range("A1").Value + Int(X / 8)
Next
End If
End If
End Sub
 
R

Ricky

Rick - if I may, can I ask for another tweak? Can I get each of the
last 8 days formated with a bottom border line at all?

This will format the date column A similar to that of all the other data
that appears on the worksheet, that is, have a line separating each day.

And thanks also Jacob, I'll be using your macro elswhere!

Cheers
 
R

Rick Rothstein

This should do it for you...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim X As Long
If Target.Address = "$A$1" And IsDate(Target.Value) Then
Range("A2:A248").Clear
If Day(Target.Value) = 1 Then
For X = 1 To 8 * Day(DateAdd("m", 1, Range("A1").Text) - 1) Step 8
With Cells(X, "A")
.Resize(8, 1).Value = Range("A1").Value + Int(X / 8)
With .Offset(7).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
End With
Next
End If
End If
End Sub

You didn't say how thick to make the borders, so I guessed at "medium" (see
the .Weight statement). You can change that if you want; your choices are
xlHairline, xlThin, xlMedium or xlThick.
 
Top