VBA Macro to move a shape based on the current date

[emmsky99]

I have a spreadsheet with a shape in the form of vertical dotted line to show the current date, which is currently being positioned manually. I'm trying to run a macro to automatically reposition the line to the current date.

The date format in my sheet is 21-Nov and I have got the macro to work if I physically enter the cell text as the date in the same format ("21-Nov"), but I want to set the macro to always move the line to the current date, without having to change the macro script. I've tried replacing the date for Date(), Current_Date etc. etc. but cannot get it to work.
Can anyone help? This is the macro I'm currently using:

Sub Check()
Dim shp As Shape
Dim r As Range, cel As Range


Set shp = ActiveSheet.Shapes("Straight Connector 2")
Set r = Range("d2:ek2")


For Each cel In r
If cel.Text = "21-Nov" Then
shp.Left = cel.Left - shp.Width
shp.Top = cel.Top - (shp.Height / 2) + (cel.Height / 2)
Exit For
End If
Next cel


End Sub

 

[emmsky99]

I have a spreadsheet with a shape in the form of vertical dotted line to show the current date, which is currently being positioned manually. I'm trying to run a macro to automatically reposition the line to the current date.

The date format in my sheet is 21-Nov and I have got the macro to work if I physically enter the cell text as the date in the same format ("21-Nov"), but I want to set the macro to always move the line to the current date, without having to change the macro script. I've tried replacing the date for Date(), Current_Date etc. etc. but cannot get it to work.
Can anyone help? This is the macro I'm currently using:

Sub Check()
Dim shp As Shape
Dim r As Range, cel As Range


Set shp = ActiveSheet.Shapes("Straight Connector 2")
Set r = Range("d2:ek2")


For Each cel In r
If cel.Text = "21-Nov" Then
shp.Left = cel.Left - shp.Width
shp.Top = cel.Top - (shp.Height / 2) + (cel.Height / 2)
Exit For
End If
Next cel


End Sub

Managed to solve myself. I needed to replace cel.Text with cel.Value