Insert new row in table below current

[ManUBlueJay]

I have a table 2 cols wide like a diary with a date for every day of the year, the second Col would be for an entry.
Cell A1 is the header row named date, Cell B1 is notes , Cell A2 =Jan 1 2021, cell A3 to A366 =the cell above plus 1. Cell B2 to B366 is blank.
So A3 would be Jan 2 2021...........
All looks good.
There are days where I would like to make another entry on the same date.
I would like some code that would insert a line below the active row but keep the same date.
When I use the code "ActiveCell.EntireRow.Insert" it inserts a row below but because the table col A is the above row +1 it will put tomorrows date in vs the active cell date.
Any help would be appreciated.

 

[NoSparks]

Copy the column A range of dates and paste it back over itself as values.

 

[ManUBlueJay]

How do I do that dynamically.
Lets say I have put an entry in B17, I would need to copy A17:B366 and insert it just below. But my B17 entry would also be copied.
If I copy only the dates then I could be shifting some entries to the wrong dates

 

[NoSparks]

What do you mean dynamically when you have a stated A2 to A366 are the formulas for the dates?

When you create this table, copy A2:A366 and paste it back over itself as values.
Now when you insert a row the date cell in the new row is blank and all the other dates have shifted down.
Isn't this what you've asked for?

 

[ManUBlueJay]

Dynamically is It needs to work wherever I am If I am in B8 it needs to insert a line in A9 where A9 now equals A8.
But it also has to owrk if I come back and add a line so I also have to copy B as you suggest.
I will now end up with a duplicate line.
I think I have come up with something that works by inserting vs copying

Sub InsertRow()

ActiveCell.Offset(1, 0).EntireRow.Insert
Range(Cells(Selection.Row + 1, 1) = Range(Cells(Selection.Row, 1).Value


End Sub

 

[NoSparks]

OK

Sub InsertRow()
    ActiveCell.Offset(1, 0).EntireRow.Insert
    Cells(Selection.Row + 1, 1) = Cells(Selection.Row, 1).Value
End Sub

 

[Marc L]

A variation :​

Sub InsertRow()
    With Rows(ActiveCell(2).Row)
        .Insert
        .Cells(1)(0) = .Cells(1)(-1)
    End With
End Sub

 

[NoSparks]

Or to deal with the table only:

Sub InsertRowInTable()
    Dim TBL As Object, i As Long
Set TBL = ActiveSheet.ListObjects(1)    'first table on sheet
With TBL
    If Not Intersect(Selection, .DataBodyRange) Is Nothing Then
        i = ActiveCell.Row - .HeaderRowRange.Row
        .ListRows.Add (i + 1)
        .DataBodyRange.Cells(i + 1, 1) = .DataBodyRange.Cells(i, 1)
        .DataBodyRange.Cells(i + 1, 2).Select
    End If
End With
End Sub

 

[ManUBlueJay]

I like the last one.
Probably safer