Tab and right arrow update row above

user_18787420 0
Viewed 37

Working on a worksheet that timestamps a localized time based on a user input in column A. It works fine if the input is entered and "enter" or "down arrow" is used to move to the next cell or the cell below. If "TAB" or "right arrow" is used to go to the next cell right it updates the date and time in the row above the current row. Here is the code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rWatchRange As Range
On Error GoTo ResetEvents
 
'Set range variable to A1:A1000
 Set rWatchRange = Range("A1:A1000")
 
    Dim Test As Double
    Test = LocalOffsetFromGMT()
    Dim first As Integer    'holds number of the first row selected
    Dim last As Integer     'holds number of the last row selected
    
    'assignments to first and last based on user cell selection
    first = Selection.Cells(1, 1).Row
    last = Selection.Cells(0, Selection.Columns.Count).Row
  
 
    'The cell they have changed (Target) _
     is within A1:A1000
    
    Select Case Target.Value

   Case "IP"
   'sets the Actual Start datetime value in columns E and F
           ActiveSheet.Range("E" & last) = Format((Now() + GetCentralOffset / 24), "M/dd/yyyy hh:mm:ss AM/PM")
           ActiveSheet.Range("F" & last) = Format((Now() + GetCentralOffset / 24), "M/dd/yyyy hh:mm:ss AM/PM")
   
   Case "ip"
   'sets the Actual Start datetime value in columns E and F
           ActiveSheet.Range("E" & last) = Format((Now() + GetCentralOffset / 24), "M/dd/yyyy hh:mm:ss AM/PM")
           ActiveSheet.Range("F" & last) = Format((Now() + GetCentralOffset / 24), "M/dd/yyyy hh:mm:ss AM/PM")
    
   Case "NS"
    'clears Actual Start/End datetime values in columns E, F, G, H
            ActiveSheet.Range("E" & last) = ""
            ActiveSheet.Range("F" & last) = ""
            ActiveSheet.Range("G" & last) = ""
            ActiveSheet.Range("H" & last) = ""
            
    Case "ns"
    'clears Actual Start/End datetime values in columns E, F, G, H
            ActiveSheet.Range("E" & last) = ""
            ActiveSheet.Range("F" & last) = ""
            ActiveSheet.Range("G" & last) = ""
            ActiveSheet.Range("H" & last) = ""
            
 
End Select
 
ResetEvents:
Application.EnableEvents = True
End Sub

Any thoughts on why it is updating the row above when TAB and right arrow are used and how to get it to update the correct row?

vba excel
1 Answers

A Worksheet Change: Timestamp

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ClearError
    
    Const rgAddress As String = "A1:A1000"
    Const tColumns As String = "E:F"
    Const cColumns As String = "E:H"
    
    Dim srg As Range: Set srg = Range(rgAddress)
    Dim irg As Range: Set irg = Intersect(srg, Target)
    
    Dim trg As Range
    Dim crg As Range
    Dim iCell As Range
 
    For Each iCell In irg.Cells
        If StrComp(CStr(iCell.Value), "Ip", vbTextCompare) = 0 Then
            If trg Is Nothing Then
                Set trg = iCell.EntireRow.Columns(tColumns)
            Else
                Set trg = Union(trg, iCell.EntireRow.Columns(tColumns))
            End If
        ElseIf StrComp(CStr(iCell.Value), "Ns", vbTextCompare) = 0 Then
            If crg Is Nothing Then
                Set crg = iCell.EntireRow.Columns(cColumns)
            Else
                Set crg = Union(trg, iCell.EntireRow.Columns(cColumns))
            End If
        'Else ' ???
        End If
    Next iCell
     
    Application.EnableEvents = False
     
    If Not trg Is Nothing Then trg.Value = Format((Now() _
        + GetCentralOffset / 24), "M/dd/yyyy hh:mm:ss AM/PM")
    If Not crg Is Nothing Then crg.ClearContents

SafeExit:
    On Error Resume Next
        If Not Application.EnableEvents Then Application.EnableEvents = True
    On Error GoTo 0
    Exit Sub
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume SafeExit
End Sub
user_98140690
Related