Hello,
I currently use the code below to calculate the time between two sets of meter reading for water usage.
In column A I have the date, Formatted as dd-mmm-yyyy, The date is Merged over 4 rows
In Column B I have the Day, The Day is merged over 4 rows
InColumn C I have Time Read & Value, Last Reading & Value merged over 4 rows
The code works fine at present if you take a reading every day and do not go over 24 hour period. I would like to have the code to look at the date and take into account how many days have been accrued since the last reading. For example, if the meter reading was taken at 08.00 am on Monday 22nd May 2023 and then the reading was taken again on Thursday 25th May 2023 at 09.10 am then the code would be able to work out that the time in hours and minutes from the last reading was 72.10 as in 72 hours 10 minutes. At present for example if the time was 4.37 pm, I would enter the time as follows 1637 and all would work fine.
I am very grateful for the help I have received in the past on this forum.
See picture of Spread sheet below.
I currently use the code below to calculate the time between two sets of meter reading for water usage.
In column A I have the date, Formatted as dd-mmm-yyyy, The date is Merged over 4 rows
In Column B I have the Day, The Day is merged over 4 rows
InColumn C I have Time Read & Value, Last Reading & Value merged over 4 rows
The code works fine at present if you take a reading every day and do not go over 24 hour period. I would like to have the code to look at the date and take into account how many days have been accrued since the last reading. For example, if the meter reading was taken at 08.00 am on Monday 22nd May 2023 and then the reading was taken again on Thursday 25th May 2023 at 09.10 am then the code would be able to work out that the time in hours and minutes from the last reading was 72.10 as in 72 hours 10 minutes. At present for example if the time was 4.37 pm, I would enter the time as follows 1637 and all would work fine.
I am very grateful for the help I have received in the past on this forum.
See picture of Spread sheet below.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Debug.Print Target.Text & " " & Target.Value & " " & Target.Value2
Dim vVal
If Target.Cells.Count > 1 Then Exit Sub
If IsEmpty(Target.Value) Then Exit Sub '<<<<<< added this line
If Intersect(Target, Range("C5:C7")) Is Nothing _
And Intersect(Target, Range("C9:C501")) Is Nothing _
And Intersect(Target, Range("C505:C997")) Is Nothing _
And Intersect(Target, Range("C73:C75")) Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error GoTo ErrHandler
If IsNumeric(Target.Value) Then
If Val(Target.Value) <> Int(Val(Target.Value)) Then
Application.EnableEvents = True
Exit Sub
End If
vVal = Format(Target.Value, "0000")
vVal = Left(vVal, 2) & ":" & Right(vVal, 2)
Target.Value = vVal
Else
If Target.Column < 2 Then
Application.EnableEvents = True
Exit Sub
End If
If Target.Row > 3 Then Target.Value = UCase(Target.Value)
End If
ErrHandler:
Application.EnableEvents = True
If Err <> 0 Then MsgBox "Error " & Err
End Sub