Date validity period in powerpoint VBA

[mollovg]

Hello Again,

I am making a powerpoint presentation whereby the user can change scrolling promotion text by opening an Inputbox and entering the text they want and that would apply to all slides, thats done now thanks to the kind help from this forum. I was wondering if it is possible to allow the user to enter a date when they would like the promotion text to start scrolling and then a date when for the promotion text to stop, for example after that date the textbox where the promotion text is would clear when the date passes? also iif the date is not today for example the text would start scrolling when the date is the date the user wants the text to start scrolling? This is what I have done in terms of code so far but it doesnt seem to work, any help would be greatly appreciated.

Private Sub CheckBox1_Click()
Dim startDate As Date
Dim endDate As Date
Dim i As Integer
Dim promo As String
Dim LDate As String
LDate = Date
Label4.Caption = LDate
i = 1
promo = InputBox("Please enter the promotion text you would like to display")
startDate = InputBox("Please enter the Date the promotion is to start")
endDate = InputBox("Please enter the Date the promotion is to end")
'check if there is already a promotion going'
If now = startDate Then
For i = 1 To ActivePresentation.Slides.Count
ActivePresentation.Slides(i).Shapes("Rectangle 11").TextFrame.TextRange = promo
Label1.Caption = promo
Label2.Caption = startDate
Label3.Caption = endDate
Next i
End If
If startDate > now Then
For i = 1 To ActivePresentation.Slides.Count
ActivePresentation.Slides(i).Shapes("Rectangle 11").TextFrame.TextRange = ""
Next i
End If
End Sub

[mollovg]

Well actusally I have got this far and it doesnt work:

Dim v As String
Dim expiry As Date
Dim dNow As Date
Dim promo As String
Dim i As Integer
Dim e As Integer
expiry = InputBox("Please enter the date for the promotion to expire")
promo = InputBox("Please enter the promotion text you would like to display")
dNow = now
e = DateDiff("d", dNow, expiry)
i = 1
If dNow < expiry Then
MsgBox "The promotion will expire on" & vbCrLf & expiry
For i = 1 To ActivePresentation.Slides.Count
ActivePresentation.Slides(i).Shapes("Rectangle 11").TextFrame.TextRange = promo
Next i
Else
If e = 0 Then
For i = 1 To ActivePresentation.Slides.Count
ActivePresentation.Slides(i).Shapes("Rectangle 11").TextFrame.TextRange = ""
Next i
Else
If expiry < dNow Then
MsgBox "The Date you set is before today. Please set a Date after" & vbCrLf & dNow
End If
End If
End If

Any help would be great bexcause it isnt working and I cant figure out why

Thanks