DateDiff in VBA

[Timmo7410]

Hi,
Having trouble getting the following code to run. Any thoughts ?
I'd like to call the function only if a dates exist within any one row of the ranges within columns D or E? Is this possible ?

-------------------------------------------------
Sub TimeReg()
Dim StartDate As Range
Dim EndDate As Range
Dim Answer As Range
If StartDate > EndDate Then
Err.Raise 5
Exit Function
End If
Set StartDate = ActiveSheet.Range("D16:D100")
Set EndDate = ActiveSheet.Range("E16:E100")
Set Answer = ActiveSheet.Range("F16:F100")

Answer = DateDiff("d", StartDate, EndDate)
End Sub

 

[MARK858]

I'd like to call the function only if a dates exist within any one row of the ranges within columns D or E? Is this possible ?

Not sure exactly what you mean by this statement as it is a regular sub you are running (except you put the function statement in the middle)

But the basics of what you are trying to do is

Sub TimeReg2()
    Dim StartDate As Range, i As Range
    Set StartDate = ActiveSheet.Range("D16:D100")
   For Each i In StartDate
        If i < i.Offset(, 1) Then
         i.Offset(, 2) = DateDiff("d", i, i.Offset(, 1))
                End If
            Next
         End Sub

or just

Sub TimeReg()
    Dim StartDate As Range, i As Range
    Set StartDate = ActiveSheet.Range("D16:D100")
   For Each i In StartDate
        If i < i.Offset(, 1) Then
         i.Offset(, 2) = i.Offset(, 1) - i
                End If
            Next
         End Sub

 

[Timmo7410]

Hi,
Thanks for the reply, I want the macro nested under the following code so that it will run calculate the difference automatically once someone has entered a date into two cells within the range.
So the macro needs to be called once there is data within each of the cells within that row within those ranges. It would also hopefully clear the calculation for that row if someone deletes a date within a cell within the range.



Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Not Application.Intersect(Target, Range("D16:D100", "E16:E100")) Is Nothing Then
Call DateCheck
End If
End Sub
-----------------------------------------
Sub DateCheck()
Dim start_date As Integer
Dim UserEntry As String
Dim Msg As String
Dim TheDate As String
Msg = "Enter Date as dd/mm/yy"
Do
UserEntry = InputBox(Msg)
If UserEntry = "" Then Exit Sub
If IsDate(UserEntry) Then
ActiveCell.Value = Format(UserEntry, "dd/mm/yy")
ActiveCell.Offset(0, 1).Select
Exit Sub
Else
Msg = "Please try again. Enter date as dd/mm/yy"
End If
Loop
End Sub

 

[MARK858]

An ugly way but try...

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    If Not Application.Intersect(Target, Range("D16:D100", "E16:E100")) Is Nothing Then
        Call DateCheck
    End If
    If IsEmpty(Cells(Target.Row, "D")) = False And IsEmpty(Cells(Target.Row, "E")) = False Then
        If Cells(Target.Row, "E") > Cells(Target.Row, "D") Then
            Cells(Target.Row, "F") = Cells(Target.Row, "E") - Cells(Target.Row, "D")
        End If
    End If
End Sub

and please use Code Tags tags around your code (and ideally indent it)

 

[MARK858]

You might want to also look at your DateCheck sub and do something like

Sub DateCheck()
    Dim start_date As Integer
    Dim UserEntry As String
    Dim Msg As String
    Dim TheDate As String
    Do
        UserEntry = Application.InputBox("Enter Date as dd/mm/yy")
        UserEntry = Format(UserEntry, "dd/mm/yy")
        If UserEntry = "" Then Exit Sub
        If IsDate(UserEntry) Then
            ActiveCell.Value = CDate(UserEntry)
            ActiveCell.Offset(0, 1).Select
            Exit Sub
        Else
            Msg = "Please try again. Enter date as dd/mm/yy"
        End If
    Loop
End Sub

to see what I mean type 12/10/13 in column D then type 16/12/13 in column E and see what Column E looks like using your original sub.
You'll probably find it is displaying as text and not a real date with your original code.