Dim oldVal As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Target.Column = 11 Then
oldVal = Target.Value
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B:H,J:K,M:N")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Dim fnd As Range, lRow As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo errHandler
Select Case Target.Column
Case 2 To 8
If Range("K" & Target.Row) <> "" Then
Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
If Not fnd Is Nothing Then
Sheets(Range("K" & Target.Row).Value).Cells(fnd.Row, Target.Column) = Target
End If
End If
Case Is = 10
If Range("K" & Target.Row) <> "" Then
Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
If Not fnd Is Nothing Then
Sheets(Range("K" & Target.Row).Value).Cells(fnd.Row, Target.Column) = Target
End If
End If
Select Case Target.Value
Case "Terminated"
Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = 3
Case "Inactive"
Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = 33
Case "Active"
Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = xlNone
End Select
Case Is = 11
If oldVal <> "" Then
Set fnd = Sheets(oldVal).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
If Not fnd Is Nothing Then
Sheets(oldVal).Rows(fnd.Row).Delete
With Sheets(Target.Value)
lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Intersect(Rows(Target.Row), Range("A:H")).Copy .Range("A" & lRow)
.Range("J" & lRow).Formula = "=DATEDIF(I" & lRow & ",TODAY(),""y"")"
Intersect(Rows(Target.Row), Range("L:M")).Copy .Range("I" & lRow)
Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("K" & lRow)
Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("M" & lRow)
End With
Else
With Sheets(Target.Value)
lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Intersect(Rows(Target.Row), Range("A:H")).Copy .Range("A" & lRow)
.Range("J" & lRow).Formula = "=DATEDIF(I" & lRow & ",TODAY(),""y"")"
Intersect(Rows(Target.Row), Range("L:M")).Copy .Range("I" & lRow)
Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("K" & lRow)
Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("M" & lRow)
End With
End If
Else
With Sheets(Target.Value)
lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Intersect(Rows(Target.Row), Range("A:H")).Copy .Range("A" & lRow)
.Range("J" & lRow).Formula = "=DATEDIF(I" & lRow & ",TODAY(),""y"")"
Intersect(Rows(Target.Row), Range("L:M")).Copy .Range("I" & lRow)
Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("K" & lRow)
Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("M" & lRow)
End With
End If
Target.Offset(, 1).Select
Case Is = 14
If Range("K" & Target.Row) <> "" Then
Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
If Not fnd Is Nothing Then
Sheets(Range("K" & Target.Row).Value).Cells(fnd.Row, 11) = Target
End If
End If
End Select
errHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub