How to Auto Insert Today's Date?????

[SWB41]

This code prompts the user to select how many rows they want to add and then subsequently copies the formulas down into the newly added rows. I does everything I want except one thing: I want today's date to be inserted in the correct cells within each newly inserted row. Column B contains the cells where I want today's date to be entered.

For example, if the user adds two rows (rows 7-8) using my macro, I want today's date to automatically appear in B7 and B8. Tomorrow when the user wants to add three more rows (rows 9-11), rows 7-8 still have yesterday's date when the macro was ran and the new rows have today's date.

I hope that makes sense. I would appreciate any help out there.

Sub InsertRowsAndFillFormulas()
Sheet1.Unprotect Password:="p@ssword9"
Dim vRows As Long
Dim sht As Worksheet, shts() As String, i As Long

Cells(TotalCount + 6, 6).Select 'I know I have 5 header rows
ActiveCell.EntireRow.Select
vRows = _
Application.InputBox(prompt:= _
"How many rows do you want to add?", Title:="Add Rows", _
Default:=1, Type:=1) 'type 1 is number
If vRows = False Then Exit Sub
'if you just want to add cells and not entire rows
' then delete ".EntireRow" in the following line
ReDim shts(1 To Worksheets.Application.ActiveWorkbook. _
Windows(1).SelectedSheets.Count)
i = 0
'insert rows on grouped worksheets
' rev. 2001-01-17 Gary Brown
For Each sht In _
Application.ActiveWorkbook.Windows(1).SelectedSheets
Sheets(sht.Name).Select
i = i + 1
shts(i) = sht.Name
Selection.Resize(rowsize:=2).Rows(2).EntireRow. _
Resize(rowsize:=vRows).Insert Shift:=xlDown
Selection.AutoFill Selection.Resize(rowsize:=vRows + 1), _
xlFillDefault
On Error Resume Next
Selection.Offset(1).Resize(vRows).EntireRow. _
SpecialCells(xlConstants).ClearContents
Next sht
Worksheets(shts).Select
Sheet1.Protect Password:="p@ssword9"
End Sub

 

[Blade Hunter]

This will put todays date in Cells A2:A14

Range("A2:A14").formula = Format(now(),"DD/MM/YYYY")

Change the range to what you need.

 

[SWB41]

Yes, thank you, but I need a string of code that will only enter today's date in the n number of inserted rows selected by the user. Based on my original post, my code prompts the user to select the number of rows they wish to insert. Column B in the new rows is where I want today's date automatically entered.

If you can, please see my code in my original post and let me know where I should enter a line or two of code that will do what I need.

Thanks!

 

[Blade Hunter]

What row do the new rows start at?

 

[SWB41]

Well, the first five rows are header rows, and row six is my first row where data is entered. Row six is my very first row of data which contains my formulas. Therefore, if my database is blank, the first row inserted will be row 7 through whatever number the user selects.

If you think you can help, I'd be happy to email you the file if you provide me your email address.

 

[Blade Hunter]

And when new rows are added are they added at the top of the bottom?

 

[SWB41]

New rows are added below.

 

[Blade Hunter]

There will be a better way to find the cells you need to manipulate but I modified the original code as I have to rush in to a meeting, see if this works:

Sub InsertRowsAndFillFormulas()
Sheet1.Unprotect Password:=p@ssword9
Dim vRows As Long
Dim sht As Worksheet, shts() As String, i As Long
Cells(TotalCount + 6, 6).Select 'I know I have 5 header rows
ActiveCell.EntireRow.Select
vRows = Application.InputBox(prompt:="How many rows do you want to add?", Title:="Add Rows", Default:=1, Type:=1)  'type 1 is number
If vRows = False Then Exit Sub
'if you just want to add cells and not entire rows
'then delete ".EntireRow" in the following line
ReDim shts(1 To Worksheets.Application.ActiveWorkbook. _
Windows(1).SelectedSheets.Count)
i = 0
'insert rows on grouped worksheets
' rev. 2001-01-17 Gary Brown
For Each sht In Application.ActiveWorkbook.Windows(1).SelectedSheets
    Sheets(sht.Name).Select
    i = i + 1
    shts(i) = sht.Name
    Selection.Resize(rowsize:=2).Rows(2).EntireRow.Resize(rowsize:=vRows).Insert Shift:=xlDown
    Selection.AutoFill Selection.Resize(rowsize:=vRows + 1), xlFillDefault
    Range("B" & Split(Selection.Resize(rowsize:=2).Rows(2).EntireRow.Resize(rowsize:=10).Address, ":")(0) & ":B" & Split(Selection.Resize(rowsize:=2).Rows(2).EntireRow.Resize(rowsize:=10).Address, ":")(1)).Formula = Format(Now(), "DD/MM/YYYY")
    On Error Resume Next
    Selection.Offset(1).Resize(vRows).EntireRow.SpecialCells(xlConstants).ClearContents
Next sht
Worksheets(shts).Select
Sheet1.Protect Password:=p@ssword9
End Sub