Macro populates wrong values - current date - vba

Question

I would like to ask for a help. My Macro was about to populate the current date to all populated rows. At the begining it seemed to work and suddenly it started to change (overwrite) the header to the current date and put the current date in 1 cell below. Could anyone help me what should I amend to make it work properly?
Here is the macro code (reformatted):
Sub DateVerified()
Sheets("Data").Activate
Dim rngAddress As Range
Set rngAddress = Range("A1:ZZ1").Find("Verified Date").Offset(1, 0)
rngAddress.Select
Dim ac As Integer
Dim lastr As Long
Dim sh As Worksheet
Set sh = ActiveSheet
ac = ActiveCell.Column
lastr = sh.Cells(Rows.Count, ac).End(xlUp).Row
Range(Cells(2, ac), Cells(lastr, ac)).Select
Selection.ClearContents
Selection.Formula = "=TEXT(Now(),""dd/mm/yyyy"")"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Answer 1

The following might suit:
Sub DateVerified()
Dim rngAddress As Range
Dim ac As Integer
Dim lastr As Long
Dim sh As Worksheet
Sheets("Data").Activate
Set rngAddress = Range("A1:ZZ1").Find("Verified Date").Offset(1, 0)
rngAddress.Select
Set sh = ActiveSheet
lastr = sh.Cells(Rows.Count, 1).End(xlUp).Row
ac = ActiveCell.Column
Range(Cells(2, ac), Cells(lastr, ac)).Select
Selection.ClearContents
Selection.Formula = "=TEXT(Now(),""dd/mm/yyyy"")"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
End Sub

Answer 2

I think that this is likely to be going wrong on the line below:
lastr = sh.Cells(Rows.Count, ac).End(xlUp).Row
This attempts to go to the final row of the spreadsheet for the active column and then do the equivalent of ctrl+up in excel to find the last row populated in that column. To test this theory add a line of code directly after this:
debug.print "lastr set to " & lastr
and see what this value is set to looking at the immediate window (use Ctrl+G to open from the VBA editor).