Subtract X hours from entered value

[Anne Troy]

In a cell called offtime, I will enter 2 or 3, depending on the time of year. This indicates that I (on the east coast) am 2 or 3 hours later than the time in Phoenix AZ.

In my worksheet column K, I will enter the east coast time. I want it to auto-change my entry by deducting the value in the cell called offtime.

So far, I just have:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then
        Exit Sub
    End If
    On Error GoTo ErrHandler:
    
    If Not Application.Intersect(Me.Range("K4:K50"), Target) Is Nothing Then
        If IsNumeric(Target.Value) = True Then
            Application.EnableEvents = False
            Target.Value = Target - Range("offhours")
            
            Application.EnableEvents = True
        End If
    End If
ErrHandler:
    Application.EnableEvents = True
End Sub

Any help GREATLY appreciated!

 

[JoeMo]

Joe, thanks. I gave that a shot. It does the same as mine. Nothing. LOL

Sorry Anne, there's an error in what I posted. This works for me, if I enter just the time in col K.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
    On Error GoTo ErrHandler:
    If Not Application.Intersect(Me.Range("K4:K50"), Target) Is Nothing Then
        For Each c In Intersect(Me.Range("K4:K50"), Target)
            If IsNumeric(c.Value) = True Then
                Application.EnableEvents = False
                c.Value = c.Value - TimeSerial(Range("offhours"), 0, 0)
                Application.EnableEvents = True
            End If
       Next c
    End If
ErrHandler:
    Application.EnableEvents = True
End Sub

 

[Anne Troy]

Go into your VB Editor; With your Sheet Code Visible -- adjacent to code-line 5

Application.EnableEvents = False​

In the left margin (the thin grey strip) hover over it and then either Left click inside
or press the F9 key - that should insert a red/maroon bullet/ball (indicating you have just assigned a breakpoint) which means when the code is triggered it will RUN up to this Line and STOP/HALT.. Go into a suspense mode. Back at your worksheet -- make a change which will fire or trigger the code and it should run the 1st 4 lines and stop @ Line 5 (the breakpoint line).
From this point on you can step thru one line at a time by pressing the F8, F8, F8 executing code lines 5,6 and 7 to the end (last code line End Sub).
During this operation you should see what the code is doing or not doing. REMOVE the Breakpoint before Saving or exiting either by left-clicking on the red/maroon dot/ball or with the cursor over the dot/ball press the F9 key. Hope this helps. Jim

​

Excellent instructions. I've done this before. But when I hit F8, I just get yelled at.
Your latest piece of code still does nothing. I know this is very annoying.

 

[JoeMo]

If the code I posted in post #11 does nothing then check to see if you have inadvertently disabled events. To do this open the VBE, press ctrl+g to open the Immediate Window, in the Immediate Window type (w/o the quotes): "Application.EnableEvents = True" and hit enter. This will enable events so you can try entering a time again.

 

[Anne Troy]

Okay!

My first problem was a disappearing immediate window. God knows why. I don't believe I've ever used it on this PC. I got it back using these instructions: https://www.objectclarity.com/2011/12/hey-where-did-my-immediate-window-go/

Ran the enable, but nothing changed.

Then, I decided to ditch the cell reference and just subtract the 2 hours right in the code. For whatever reason, that worked.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
    On Error GoTo ErrHandler:
    If Not Application.Intersect(Me.Range("K4:K50"), Target) Is Nothing Then
        For Each c In Intersect(Me.Range("K4:K50"), Target)
            If IsNumeric(c.Value) = True Then
                Application.EnableEvents = False
                c.Value = c.Value - 0.083333
                Application.EnableEvents = True
                
            End If
       Next c
    End If
ErrHandler:

End Sub

Thanks very much for your perseverance!