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.
Thanks, 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
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