Time diffrence between two date stamps, faulty VBA

[Martu Theophilus]

Dear Experts,

Could you please help me to repair my macro in VBA. The aim is to put in a column R the time difference in days ( can also show hours) between later date stamp column M and the first date stamp in column B. The macro attached below works and calculates the difference in days, however it runs the macro till the end of the column R. returning the value of 0, even when columns B and M are empty. I would like the calculation only to be done when there is a value in the time stamp cells in column B and M.
I would be grateful for yours suggestions.

Kind regards

Martek

Sub datediff()


With Range("R12:R" & Range("B" & Rows.Count).End(xlDown).Row)

.FormulaR1C1 = "=datedif(rc[-16],rc[-5],""d"")"

Dim x As Integer

      Application.ScreenUpdating = False

      ' Set numrows = number of rows of data.

           ' Establish "For" loop to loop "numrows" number of times.

               ' Insert your code here.

         ' Selects cell down 1 row from active cell.

        

      End With

End Sub

I have tried with .End(xlUp) however the loop is stopped and column r does not show any data -

the time difference calculation does not work anymore....... Any ideas which formula is the best to simply calculate the difference between two date stamps.

Thank you
M

 

[Joe4]

Maybe try changing the first two rows of that procedure like this:

With Range("R12:R" & Range("B" & Rows.Count).End(xlUp).Row)
    .FormulaR1C1 = "=IF(AND(RC[-16]>0,RC[-5]>0),DATEDIF(RC[-16],RC[-5],""d""),"""")"

 

[Martu Theophilus]

Dear Joe4,

Thank you so much! I am really excited it works. However, the macro only updates in Run/sub Mode F5 and not when I update the sheet?
Do you have any ideas how to enable that?

Many thanks, I really do appreciate your help,
M

 

[Joe4]

If you want it to run automatically upon manual entry of data on the sheet, then you need to use the Worksheet_Change event procedure, which needs to be placed in the Sheet module of the sheet you wish it to run against.

When do you want this to be run? When there is a manual change to the data in column B?

 

[Martu Theophilus]

Dear Joe,

The date difference I expect in the column R. I tried to put this in module.

The rest of macro is placed in project:
see below all my commands

Private Sub Worksheet_Change(ByVal Target As Range)

' You arrive in this subroutine whenever ANYTHING changes in the
' "Tracking" worksheet. The code below has to decide whether to take any action.

Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer

' Here, you set a variable called WorkRng according to whether the present position
' of the cursor is in column "A". If the cursor is in column "A", then WorkRng will
' have a usable value. If not, then WorkRng will be equivalent to "Nothing".
Set WorkRng = Intersect(Application.ActiveSheet.Range("A:A"), Target)

' xOffsetColumn is going to be used to select which column you change, if anything needs changing at all.
xOffsetColumn = 1

' The test below determines whether WorkRng has a value. If it has, then the
' cursor was is column "A" when you made the change.
If Not WorkRng Is Nothing Then
' OK - we are going to do something that might make a change, and so we must disable the
' Events tracking so that we don't get caught in a never-ending loop.
Application.EnableEvents = False
For Each Rng In WorkRng
' The test below is to find out whether there is actually a value in the cell
' where the cursor is.
If Not VBA.IsEmpty(Rng.Value) Then
' If the cell is not empty, then the following actions will take place.
' The xOffsetColumn was set to 5, so the cell five columns to the right will
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd/mm/yyyy, hh:mm"
Else
' But if the cell WAS empty, then we get here, and the line below clears the date stamp five columns to the right.
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
' And now we re-enable Events tracking ready for the next change.
Application.EnableEvents = True
End If

' Now we do all the same stuff to find out whether the change was made in column "L".
Set WorkRng = Intersect(Application.ActiveSheet.Range("L:L"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd/mm/yyyy, hh:mm"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True

End If
End Sub


.................................................................................................................................................................................................................................................
The last command doesn't work as expected in the module, only by play sub and if i add to the protect it doesn't work at all
Public Sub diff()

With Range("R12:R" & Range("B" & Rows.Count).End(xlUp).Row)
.FormulaR1C1 = "=IF(AND(RC[-16]>0,RC[-5]>0),DATEDIF(RC[-16],RC[-5],""d""),"""")"


Dim x As Integer

Application.ScreenUpdating = False

' Set numrows = number of rows of data.

' Establish "For" loop to loop "numrows" number of times.

' Insert your code here.

' Selects cell down 1 row from active cell.
End With
End Sub

MM

 

[Joe4]

Your reply is very hard to read. Can you post your code using Code Tags, like in your original post, so it is more readable?
Also, by default, the Worksheet_Change event procedure is fired anytime any manual change is made. Usually, that is overkill, and you really only want it to run when changes to certain ranges are made (I am thinking maybe column B in your example, since that is what is used to determine the range to run it on in your WITH statement). Would you agree?

Also, if your code is actually updating cells on the worksheet, it may be important to account for that in the code, or else you could possibly be caught in an endless loop, as changes made by the code trigger the Worksheet_Change procedure to run again (so the code is calling itself).

Think of a simple example like this. Suppose that we had a Worksheet_Change procedure that runs whenever there is an update on the sheet, the code will add 1 to the value in cell A1. So when that runs, since it is changing the value in cell A1, it calls itself again, and keeps adding 1 to the value in A1 in an endless loop. So in certain cases, we need to temporarily disable events from firing while we are updating certain cells.

 

[Martu Theophilus]

Dear Joe,

Somehow it works, however the file is more then 34MB in size and as you have mentioned it runs in the endless loop... I am sure it would make more sense if you would be able to see the spread sheet , unfortunately I can't upload the file on this site.
Thank you very much for your patience and help so far.

MM

 

[Joe4]

If you put a breakpoint at the beginning of your Worksheet_Change code, so it will stop it on that line when the call is called, make a change and then when it stops, go through your code line-by-line using the F8 key, and see if you can find exactly where it is going into the endless loop, and that is probably the part that needs editing.

 

[Martu Theophilus]

Just wanted to say a big thank you, unfortunately I am a complete novice and have to rely on luck a lot

Private Sub Worksheet_Change(ByVal Target As Range)

' You arrive in this subroutine whenever ANYTHING changes in the
' "Tracking" worksheet.  The code below has to decide whether to take any action.

Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer

' Here, you set a variable called WorkRng according to whether the present position
' of the cursor is in column "A".  If the cursor is in column "A", then WorkRng will
' have a usable value.  If not, then WorkRng will be equivalent to "Nothing".
Set WorkRng = Intersect(Application.ActiveSheet.Range("A:A"), Target)

' xOffsetColumn is going to be used to select which column you change, if anything needs changing at all.
xOffsetColumn = 1

' The test below determines whether WorkRng has a value.  If it has, then the
' cursor was is column "A" when you made the change.
If Not WorkRng Is Nothing Then
    ' OK - we are going to do something that might make a change, and so we must disable the
    ' Events tracking so that we don't get caught in a never-ending loop.
    Application.EnableEvents = False
    For Each Rng In WorkRng
        ' The test below is to find out whether there is actually a value in the cell
        ' where the cursor is.
        If Not VBA.IsEmpty(Rng.Value) Then
            ' If the cell is not empty, then the following actions will take place.
            ' The xOffsetColumn was set to 5, so the cell five columns to the right will
            Rng.Offset(0, xOffsetColumn).Value = Now
            Rng.Offset(0, xOffsetColumn).NumberFormat = "dd/mm/yyyy, hh:mm"
        Else
            ' But if the cell WAS empty, then we get here, and the line below clears the date stamp five columns to the right.
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    ' And now we re-enable Events tracking ready for the next change.
    Application.EnableEvents = True
End If

' Now we do all the same stuff to find out whether the change was made in column "L".
Set WorkRng = Intersect(Application.ActiveSheet.Range("L:L"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = Now
            Rng.Offset(0, xOffsetColumn).NumberFormat = "dd/mm/yyyy, hh:mm"
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    Application.EnableEvents = True

End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

With Range("R12:R" & Range("B" & Rows.Count).End(xlUp).Row)
    .FormulaR1C1 = "=IF(AND(RC[-16]>0,RC[-5]>0),DATEDIF(RC[-16],RC[-5],""d""),"""")"
Dim x As Integer
      Application.ScreenUpdating = False

      ' Set numrows = number of rows of data.

           ' Establish "For" loop to loop "numrows" number of times.

               ' Insert your code here.

         ' Selects cell down 1 row from active cell.
End With
End Sub

 

[Joe4]

So, is it working for you now?
If not, what is the current problem you are having?

And why did you put the second code in a "Worksheet_SelectionChange" event procedure?
It seems like that is going to run it a lot more than is necessary (it will run it whenever you select a cell/move around on your worksheet).

If it helps for me to see the sheet, try to make a scaled down version of the file (so it is a lot smaller), and then upload it to a file shaing site (like DropBox), and provide a link here to it.
And then tell me the actions to take on the sheet to call the macro (and describe what should happen when I do that).