Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Worksheet Change Event, Enter vs. Tab vs. Cursor movement 1

Status
Not open for further replies.

renigar

Technical User
Jan 25, 2002
107
US
I checked the forum and this question has been asked but the answer was too vague for my understanding. The macro acts on different rows depending on weather the enter key is used or tab or cursor up, down , left, right. I want whatever method triggers the event to have the same effect as pressing enter. Code follows, comments will tell you what's supposed to happen. It works great as long as Enter key is used to trigger event. Feel free to throw any other improvement tips my way. I can always use more knowledge.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'
' This macro copies the row where an inspection date was entered in column F and
' inserts it in the next row with the next inspection date according to the inspection interval
'
Application.ScreenUpdating = False
Application.EnableEvents = True
'
Dim lastrow As Long
Dim RowNum As Long

' Find the last row of data in column A (the 1 in the formula)
    lastrow = Cells(Rows.Count, 1).End(xlUp).Row

' Check if macro should be on or off
    If Range("F3").Value = "Off" Then Exit Sub
    
' Skip over code if cell that is changed is not in column F
    If Not Intersect(Target, Range("F6:F" & lastrow)) Is Nothing Then
    
' Do nothing if more than one cell is changed or content deleted
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

' Get the active row number
    RowNum = ActiveCell.Row

' Turn off events so macro doesn't go into endless loop
Application.EnableEvents = False

' Copy row of data that inspection date was entered into !!!!!!!! Copy only to column F !!!!!!
    Range("A" & RowNum - 1 & ":" & "F" & RowNum - 1).Copy
    
' Check if the cell in the "Indicate Violation column is not empty
        If Range("E" & RowNum - 1).Value <> "" Then
        
' If *** violation *** is indicated insert data into next 2 rows - *******************************
        Range("A" & RowNum & ":J" & RowNum + 1).Insert Shift:=xlDown

' Add 1 year to the date in column F, one row below the entered inspection date
        Range("F" & RowNum).Formula = "=DATE(YEAR(F" & RowNum - 1 & ") + 1" & ",MONTH(F" & RowNum - 1 & "),DAY(F" & RowNum - 1 & "))"
' Add 2 years to the date in column F, two rows below the entered inspection date
        Range("F" & RowNum + 1).Formula = "=DATE(YEAR(F" & RowNum - 1 & ") + 2" & ",MONTH(F" & RowNum - 1 & "),DAY(F" & RowNum - 1 & "))"

' Change the formula to a value
        Range("F" & RowNum & ":F" & RowNum + 1).Value = Range("F" & RowNum & ":F" & RowNum + 1).Value
        
' Change the color of the two new "Inspection Interval" cells to red, the values to one and blank the violation indicators
        Range("D" & RowNum & ":D" & RowNum + 1).Interior.Color = RGB(255, 0, 0)
        Range("D" & RowNum & ":D" & RowNum + 1).Value = 1
        Range("E" & RowNum & ":E" & RowNum + 1).Value = ""
        
' Move back to the originally selected cell
'    ActiveCell.Offset(rowOffset:=-1, columnOffset:=0).Activate
        
        Else
    
' If *** no violation *** is indicated insert data into next row - ******************************
        Rows(RowNum & ":" & RowNum).Insert Shift:=xlDown
    
' Add the year in column F current row to the number in column D current row to get next inspection date
        Range("F" & RowNum).Formula = "=DATE(YEAR(F" & RowNum - 1 & ") + D" & RowNum - 1 & ",MONTH(F" & RowNum - 1 & "),DAY(F" & RowNum - 1 & "))"
' Changer the formula to a value
        Range("F" & RowNum).Value = Range("F" & RowNum).Value
    
' Move back to the originally selected cell
'    ActiveCell.Offset(rowOffset:=-1, columnOffset:=0).Activate
    
        End If
    End If
Application.CutCopyMode = False
    
' Turn events back on
Application.EnableEvents = True
Application.ScreenUpdating = True
    
End Sub

Thanks, renigar
 
The 'change' event fires when the worksheet's contents that can be edited in the formula bar changes.
So you may need either Application.OnKey method or API function to handle key actions. They are linked to whole excel instance.
The more secure are native excel worksheet events, you may consider adding 'SelectionChange' event to your project.

combo
 
It works great as long as Enter key is used to trigger event.

As combo pointed out the Enter key has nothing to do with the Worksheet Change event. The change has to do with characters changing in the Value of the Target range.

In your code you seem concerned with the ActiveCell, Activate, the originally selected cell. I would NEVER use ActiveCell or Activate in this event.

You seem to forget that the key element in this event processing is the Target range object. If you must "Move back to the originally selected cell" then...
Code:
Target.Select

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein
AD1D550E-FCB5-4AB6-A3C8-1F86CACE2554_ne1bcz.jpg
 
BTW, your apparent issue, associated with "Enter vs. Tab vs. Cursor movement" hinged on where the ActiveCell is at the moment the event fires.

Here's the rub. When you hit Enter, the ActiveCell becomes the cell just below the Top-Left corner of the Target range. When you Tab, its the cell to the right of, unless its in a Structured Table where the Target cell is in a table with multiple columns and in the last column of the table, in which case the ActiveCell would be in the next row of the first column of the table.

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein
AD1D550E-FCB5-4AB6-A3C8-1F86CACE2554_ne1bcz.jpg
 
Combo and Skip,
Let me research what you've given me and see what I can do.
Thanks for the tips,
renigar
 
Skip,
Your statement about not using ActiveCell or Activate and focusing on the target range object clicked. It made all the difference. Now the code works no matter how the user leaves the cell. Thanks again for sharing your knowledge. I had to make a few additional small changes to the code once I figured it out. I am posting revised code in case it could help someone else understand.
renigar

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'
' This macro copies the row where an inspection date was entered in column F and
' inserts it in the next row with the next inspection date according to the inspection interval
'
Application.ScreenUpdating = False
Application.EnableEvents = True
'
Dim lastrow As Long
Dim RowNum As Long

' Find the last row of data in column A (the 1 in the formula)
    lastrow = Cells(Rows.Count, 1).End(xlUp).Row

' Check if macro should be on or off
    If Range("F3").Value = "Off" Then Exit Sub
    
' Skip over code if cell that is changed is not in column F
    If Not Intersect(Target, Range("F6:F" & lastrow)) Is Nothing Then
    
' Do nothing if more than one cell is changed or content deleted
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

' Get the active row number
    [highlight]RowNum = Target.Row[/highlight]  ' Changed from RowNum = ActiveCell.Row made the difference 

' Turn off events so macro doesn't go into endless loop
Application.EnableEvents = False

' Copy row of data that inspection date was entered into !!!!!!!! Copy only to column F !!!!!!
'    Range("A" & RowNum - 1 & ":" & "F" & RowNum - 1).Copy
    Range("A" & RowNum & ":" & "F" & RowNum).Copy
    
' Check if the cell in the "Indicate Violation column is not empty
        If Range("E" & RowNum).Value <> "" Then
        
' If *** violation *** is indicated insert data into next 2 rows - *******************************
        Range("A" & RowNum + 1 & ":F" & RowNum + 2).Insert Shift:=xlDown

' Add 1 year to the date in column F, one row below the entered inspection date
        Range("F" & RowNum + 1).Formula = "=DATE(YEAR(F" & RowNum & ") + 1" & ",MONTH(F" & RowNum & "),DAY(F" & RowNum & "))"
' Add 2 years to the date in column F, two rows below the entered inspection date
        Range("F" & RowNum + 2).Formula = "=DATE(YEAR(F" & RowNum & ") + 2" & ",MONTH(F" & RowNum & "),DAY(F" & RowNum & "))"

' Change the formula to a value
        Range("F" & RowNum + 1 & ":F" & RowNum + 2).Value = Range("F" & RowNum + 1 & ":F" & RowNum + 2).Value
        
' Change the color of the two new "Inspection Interval" cells to red, the values to one and blank the violation indicators
        Range("D" & RowNum + 1 & ":D" & RowNum + 2).Interior.Color = RGB(255, 0, 0)
        Range("D" & RowNum + 1 & ":D" & RowNum + 2).Value = 1
        Range("E" & RowNum + 1 & ":E" & RowNum + 2).Value = ""
        
' Move back to the originally selected cell
        Target.Select
        
        Else
    
' If *** no violation *** is indicated insert data into next row - ******************************
        Rows(RowNum + 1 & ":" & RowNum + 1).Insert Shift:=xlDown
    
' Add the year in column F current row to the number in column D current row to get next inspection date
        Range("F" & RowNum + 1).Formula = "=DATE(YEAR(F" & RowNum & ") + D" & RowNum & ",MONTH(F" & RowNum & "),DAY(F" & RowNum & "))"
' Change the formula to a value
        Range("F" & RowNum + 1).Value = Range("F" & RowNum + 1).Value
    
' Move back to the originally selected cell
        Target.Select
    
        End If
    End If
    
Application.CutCopyMode = False
    
' Turn events back on
Application.EnableEvents = True
Application.ScreenUpdating = True
    
End Sub
 
renigar,
To show the appreciation for help, click on [blue]Great Post![/blue] link in Skip's reply.


---- Andy

There is a great need for a sarcasm font.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top