Insert/append todays date when workbook is open

[evenings]

Hello. I have a sheet with Dates going down column A. What I am trying to do is have todays date populate the next empty cell going down column A once the workbook is open. If todays date is present then do nothing.

Private Sub Book_Date()

ActiveWorkbook.Sheets("MySheet").Activate

    Range("A21").Select

    Do

    If IsEmpty(ActiveCell) = False Then

        ActiveCell.Offset(1, 0).Select

    End If

    Loop Until IsEmpty(ActiveCell) = True

    If Range("A21") = "" Then
       Range("A21") = Now
    End If

    Range("A21").Select

End Sub

I really dont know what I am doing. But I am trying. Thanks in advance.

[nchavan]

Hi evenings,

As per my understanding about your query, you wish to add today's date in the lastrow of column A which is empty, right?

If I guessed it right then you can try this code

Private Sub Book_Date()
    Dim MaxRow As Integer
    ActiveWorkbook.Sheets("Sheet1").Activate
    'Range("A21").Select
    With ActiveWorkbook.Sheets("Sheet1")
        MaxRow = .Range("A1").End(xlDown).Row + 1
        .Cells(MaxRow, 1) = Now
    End With
End Sub

[Richard Buttrey]

Hi,

Assuming the dates are in chronological order then in the Workbook Open Event simply add

If MySheet.Range("A" & Rows.Count).End(xlUp) <> Date Then MySheet.Range("A" & Rows.Count).End(xlUp) = Date

HTH

[buran]

@nchavan: Using Now will add not only the current date, but also current time. Also if column A is empty it will leave Cell A1 blank.
@ Richard: In this case it will overwright the last cell in column A.

So I would suggest to add In ThisWorkbook module:

Private Sub Workbook_Open()
    Dim cl As Range

    Worksheets(1).Activate
    Set cl = Cells(Rows.Count, 1).End(xlUp)

    If IsEmpty(cl) Then    'No entries in Column A
        cl = Date
    ElseIf cl <> Date Then
        cl.Offset(1, 0) = Date
    End If

    Set cl=Nothing

End Sub

Buran

[Richard Buttrey]

@ Richard: In this case it will overwright the last cell in column A.

Quite correct, well spotted. I should have added a .Offset. i.e.

If MySheet.Range("A" & Rows.Count).End(xlUp) <> Date Then MySheet.Range("A" & Rows.Count).End(xlUp).Offset(1,0) = Date

Rgds

[evenings]

Thanks alot with the quick help guys. Subs are working great. thanks again