Hi missk,

Something like this might work if:

1. column B has no blanks;
2. column A has no blanks except for cells adjacent to today's entries in
column B.

Sub DateAsToday()
Dim lStartRow As Long, lLastRow As Long
Dim c As Range

lStartRow = Range("A1").End(xlDown).Row + 1
lLastRow = Range("B1").End(xlDown).Row

For Each c In Range(Cells(lStartRow, 1), Cells(lLastRow, 1))
c.Value = Date
Next

End Sub


HTH
Regards,
GS