Re: Trigger inserting date

Tech-Archive recommends: Fix windows errors by optimizing your registry



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.

--
Rick (MVP - Excel)


"Ricky" <Richard.Phelan@xxxxxxxxxxxxxx> wrote in message news:A6OdnZ1doZkk-EDUnZ2dnUVZ_t6dnZ2d@xxxxxxxxxxxxxxxxx
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 work***, that is, have a line separating each day.

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

Cheers


Ricky wrote:
Thanks very much Rick!

Rick Rothstein wrote:
Yes, we can do it automatically. The code must go in the work***'s code window. To get there, right click the work***'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


.


Quantcast