On Jan 1 annually fill first 4 columns in last empty row

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
1,069
Office Version
  1. 365
Platform
  1. Windows
Hi

On Jan 1 every year I need the following data input into the first 4 columns of the first empty row of Sheet 'Walking' exactly as below:

Col A: Jan 1 of the current year [equivalent to DATE(YEAR(TODAY()),1,1)]
Col B: "DUMMY ENTRY TO AVOID #REF! ERROR IN THIS SHEET AND TRAINING LOG J9 - OVERTYPE THIS ROW!" in bold and filled yellow
Col C: 1:00
Col D: 1

Book1
ABCD
10301/01/2022DUMMY ENTRY TO AVOID #REF! ERROR IN THIS SHEET AND TRAINING LOG J9 - OVERTYPE THIS ROW!1:001.0
Walking

I'd be very grateful for a solution.

Many thanks!
 
Last edited:
Edit - I just noticed I didn't add "()" after Date - does that make a difference? .....NO, you'll notice VBA actually removes the parens !!
Did you try the code in post #10....it doesn't open the walking sheet just makes the changes to it !!
 
Upvote 0

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Yes, unfortunately, that's how I know. I tested it with today's date, as Joe suggested. Note the workbook opens in a different sheet (I didn't include this earlier as I didn't think it was relevant).

VBA Code:
Private Sub Workbook_Open()

Sheets("Training Log").Select
Range("A23358").End(xlUp).Offset(0, 0).Select

If Date = DateSerial(2021, 9, 8)
Dim DummyRow As Long

DummyRow = Range("A" & Rows.Count).End(xlUp).Row + 1
With Worksheets("Walking")
Range("A" & DummyRow).Value = Date ()
    Range("B" & DummyRow).Value = "DUMMY ENTRY TO AVOID #REF! ERROR IN THIS SHEET AND TRAINING LOG J9 - OVERTYPE THIS ROW!"
    Range("B" & DummyRow).Interior.Color = RGB(255, 255, 0)
    Range("B" & DummyRow).Font.Bold = True
   Range("C" & DummyRow).Value = "1:00"
    Range("D" & DummyRow).Value = "1"

End With
End Sub

Is it because 2 rows were transposed and should be like this?
VBA Code:
With Worksheets("Walking")
DummyRow = Range("A" & Rows.Count).End(xlUp).Row + 1

Edit: No, it still runs in the Training Log sheet
 
Last edited:
Upvote 0
It should open in the training sheet !....BUT it runs the Walking sheet in the background.
Why did you modify the code I sent to you by removing the periods ??
VBA Code:
Private Sub Workbook_Open()
If Date = DateSerial(Year(Now), 1, 1) Then
Dim DummyRow As Long
 With sheets("Walking")
    DummyRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("A" & DummyRow).Value = Date
    .Range("B" & DummyRow).Value = "DUMMY ENTRY TO AVOID #REF! ERROR IN THIS SHEET AND TRAINING LOG J9 - OVERTYPE THIS ROW!"
    .Range("B" & DummyRow).Interior.Color = RGB(255, 255, 0)
    .Range("B" & DummyRow).Font.Bold = True
    .Range("C" & DummyRow).Value = "1:00"
    .Range("D" & DummyRow).Value = "1"
End With
end if
End Sub
 
Upvote 0
Ahh, I'm so sorry Michael, I thought you were just quoting my earlier post with the 'Date' info!

Just trying your amended code now - thanks!
 
Upvote 0
Use the code in Post#13 there was a typo in the earlier one !!
 
Upvote 0
Brilliant, that works!

Could I just please ask you to add 2 more lines of code, so the formats are the same as the row above i.e. centered alignment and fill cell for columns A, C & D = rgb, 235, 241, 222

Also, as Joe pointed out, would you be able to add another line to ensure the code only runs once on that day please?

Thanks once again Michael!
 
Last edited:
Upvote 0
MAybe this
VBA Code:
Private Sub Workbook_Open()
If Date = DateSerial(Year(Now), 1, 1) Then
Dim DummyRow As Long
 With Sheets("Walking")
    DummyRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
    If .Range("A" & DummyRow - 1).Value = Date Then Exit Sub
    .Range("A" & DummyRow).Value = Date
    .Range("B" & DummyRow).Value = "DUMMY ENTRY TO AVOID #REF! ERROR IN THIS SHEET AND TRAINING LOG J9 - OVERTYPE THIS ROW!"
    .Range("A" & DummyRow & ":D" & DummyRow).Interior.Color = RGB(255, 255, 0)
    .Range("A" & DummyRow & ":D" & DummyRow).HorizontalAlignment = xlCenter
    .Range("B" & DummyRow).Font.Bold = True
    .Range("C" & DummyRow).Value = "1:00"
    .Range("D" & DummyRow).Value = "1"
End With
End If
End Sub
 
Upvote 0
Solution
That's fantastic Michael, works perfectly thanks ever so much!

I've added a couple more formats to your code as below
VBA Code:
Private Sub Workbook_Open()
If Date = DateSerial(Year(Now), 1, 1) Then
Dim DummyRow As Long
 With Sheets("Walking")
    DummyRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
    If .Range("A" & DummyRow - 1).Value = Date Then Exit Sub
    .Range("A" & DummyRow).Value = Date
    .Range("B" & DummyRow).Value = "DUMMY ENTRY TO AVOID #REF! ERROR IN THIS SHEET AND TRAINING LOG J9 - OVERTYPE THIS ROW!"
     Range("B" & DummyRow).HorizontalAlignment = xlLeft
    .Range("B" & DummyRow).WrapText = True
    .Range("A" & DummyRow & ":D" & DummyRow).Interior.Color = RGB(255, 255, 0)
    .Range("A" & DummyRow).HorizontalAlignment = xlCenter
    .Range("A" & DummyRow & ":D" & DummyRow).VerticalAlignment = xlCenter
    .Range("A" & DummyRow & ":D" & DummyRow).Font.Name = "Comic Sans MS"
    .Range("A" & DummyRow & ":D" & DummyRow).Font.Bold = True
    .Range("A" & DummyRow & ":D" & DummyRow).Borders.LineStyle = xlContinuous
    .Range("A" & DummyRow & ":D" & DummyRow).Font.Size = 9
    .Range("C" & DummyRow).Value = "1:00"
    .Range("C" & DummyRow).NumberFormat = "[h]:mm"
    .Range("C" & DummyRow).HorizontalAlignment = xlCenter
    .Range("D" & DummyRow).Value = "1.0"
    .Range("D" & DummyRow).NumberFormat = "0.0"
    .Range("D" & DummyRow).HorizontalAlignment = xlCenter
End With
End If
End Sub

Although it all works, it looks a bit clunky with all the formatting lines! I thought there might have been a way to just copy the formatting of the row above it?

Is there any way it can be improved - no worries if not, I'm just glad it works :biggrin:
 
Upvote 0
Change to
VBA Code:
Private Sub Workbook_Open()
If Date = DateSerial(Year(Now), 1, 1) Then
Dim lr As Long
 With Sheets("Walking")
    lr = .Range("A" & Rows.Count).End(xlUp).Row + 1
    If .Range("A" & lr - 1).Value = Date Then Exit Sub
    .Range("A" & lr).Value = Date
    .Range("B" & lr).Value = "DUMMY ENTRY TO AVOID #REF! ERROR IN THIS SHEET AND TRAINING LOG J9 - OVERTYPE THIS ROW!"
    .Range("A" & lr & ":D" & lr).Interior.Color = RGB(255, 255, 0)
    .Range("A" & lr & "," & "C" & lr & ":D" & lr).HorizontalAlignment = xlCenter 'this does cols "A" & "C" & "D"
    .Range("B" & lr).Font.Bold = True
    .Range("C" & lr).Value = "1:00"
    .Range("D" & lr).Value = "1"
End With
End If
End Sub
 
Upvote 0
Thanks for sticking with me ;-) - unfortunately that now shows as it did before I made all the clunky amendments
Walking sheet.xlsm
ABCD
10223/06/2021Hallas Br/Bents Ln/Nab Ln/Down Harden Ln/Wilsden Old Rd/Narrow Ln/Harden Rd/Mad Mile/Halifax Rd/Fieldside/Viaduct to Doll Ln/Sunningdale Crescent/Greenside Ln/Home2:086.0
10309/09/2021DUMMY ENTRY TO AVOID #REF! ERROR IN THIS SHEET AND TRAINING LOG J9 - OVERTYPE THIS ROW!01:001
Walking
 
Upvote 0

Forum statistics

Threads
1,223,243
Messages
6,170,964
Members
452,371
Latest member
Frana

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