Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim xRg As Range, xCell As Range
Dim Uppercase, Lowercase
On Error Resume Next
If (Target.Count = 1) Then
Application.EnableEvents = False
If (Not Intersect(Target, Me.Range("A:A")) Is Nothing) Then
If Target = vbNullString Then
Target.Offset(0, 8) = vbNullString
Else
Target.Offset(0, 8) = Date
End If
End If
End If
Application.EnableEvents = True
If (Target.Count = 1) Then
Application.EnableEvents = False
If (Not Intersect(Target, Me.Range("C:C")) Is Nothing) Then
If Target = vbNullString Then
Target.Offset(0, 7) = vbNullString
Else
Target.Offset(0, 7) = Date
End If
End If
End If
Application.EnableEvents = True
If (Target.Count = 1) Then
Application.EnableEvents = False
If (Not Intersect(Target, Me.Range("F:F")) Is Nothing) Then
If Target = vbNullString Then
Target.Offset(0, 1) = vbNullString
Else
Target.Offset(0, 1) = Date
End If
End If
End If
Application.EnableEvents = True
If (Target.Count = 1) Then
Application.EnableEvents = False
If (Not Intersect(Target, Me.Range("K:K")) Is Nothing) Then
If Target = vbNullString Then
Target.Offset(0, 1) = vbNullString
Else
Target.Offset(0, 1) = Date
End If
End If
End If
Application.EnableEvents = True
If (Target.Count = 1) Then
Application.EnableEvents = False
If (Not Intersect(Target, Me.Range("M:M")) Is Nothing) Then
If Target = vbNullString Then
Target.Offset(0, 1) = vbNullString
Else
Target.Offset(0, 1) = Date
End If
End If
End If
Application.EnableEvents = True
If (Target.Count = 1) Then
Application.EnableEvents = False
If (Not Intersect(Target, Me.Range("P:P")) Is Nothing) Then
If Target = vbNullString Then
Target.Offset(0, 1) = vbNullString
Else
Target.Offset(0, 1) = Date
End If
End If
End If
Application.EnableEvents = True
If (Target.Count = 1) Then
Application.EnableEvents = False
If (Not Intersect(Target, Me.Range("R:R")) Is Nothing) Then
If Target = vbNullString Then
Target.Offset(0, 1) = vbNullString
Else
Target.Offset(0, 1) = Date
End If
End If
End If
Application.EnableEvents = True
If (Target.Count = 1) Then
Application.EnableEvents = False
If (Not Intersect(Target, Me.Range("U:U")) Is Nothing) Then
If Target = vbNullString Then
Target.Offset(0, 1) = vbNullString
Else
Target.Offset(0, 1) = Date
End If
End If
End If
Application.EnableEvents = True
If (Target.Count = 1) Then
Application.EnableEvents = False
If (Not Intersect(Target, Me.Range("W:W")) Is Nothing) Then
If Target = vbNullString Then
Target.Offset(0, 1) = vbNullString
Else
Target.Offset(0, 1) = Date
End If
End If
End If
Application.EnableEvents = True
If (Target.Count = 1) Then
Application.EnableEvents = False
If (Not Intersect(Target, Me.Range("Z:Z")) Is Nothing) Then
If Target = vbNullString Then
Target.Offset(0, 1) = vbNullString
Else
Target.Offset(0, 1) = Date
End If
End If
Application.EnableEvents = True
If (Target.Count = 1) Then
Application.EnableEvents = False
If (Not Intersect(Target, Me.Range("AB:AB")) Is Nothing) Then
If Target = vbNullString Then
Target.Offset(0, 1) = vbNullString
Else
Target.Offset(0, 1) = Date
End If
End If
End If
Application.EnableEvents = True
If (Target.Count = 1) Then
Application.EnableEvents = False
If (Not Intersect(Target, Me.Range("AD:AD")) Is Nothing) Then
If Target = vbNullString Then
Target.Offset(0, 1) = vbNullString
Else
Target.Offset(0, 1) = Date
End If
End If
Application.EnableEvents = True
End If
End If
If (Target.Count = 1) Then
Application.EnableEvents = False
If (Not Intersect(Target, Me.Range("AF:AF")) Is Nothing) Then
If Target = vbNullString Then
Target.Offset(0, 1) = vbNullString
Else
Target.Offset(0, 1) = Date
End If
End If
Application.EnableEvents = True
End If
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Me.Range("K:K,P:P,U:U,Z:Z,AD:AD")) Is Nothing Then
If Target = vbNullString Then
Target.Offset(0, 1) = vbNullString
Target.Offset(0, 2).Borders(xlEdgeTop).LineStyle = xlNone
Target.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlNone
Target.Offset(0, 2).Borders(xlEdgeLeft).LineStyle = xlNone
Target.Offset(0, 2).Borders(xlEdgeLeft).LineStyle = xlContinuous
Target.Offset(0, 2).Borders(xlEdgeRight).Color = RGB(0, 0, 0)
Target.Offset(0, 3).Borders(xlEdgeTop).LineStyle = xlNone
Target.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlNone
Target.Offset(0, 3).Borders(xlEdgeRight).LineStyle = xlContinuous
Target.Offset(0, 3).Borders(xlEdgeRight).Color = RGB(0, 0, 0)
Range("C" & i).BorderAround ColorIndex:=3
Else
Target.Offset(0, 1) = Date
Target.Offset(0, 2).Borders(xlEdgeTop).LineStyle = xlContinuous
Target.Offset(0, 2).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
Target.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
Target.Offset(0, 2).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
Target.Offset(0, 2).Borders(xlEdgeLeft).Color = RGB(255, 0, 0)
Target.Offset(0, 2).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
Target.Offset(0, 3).Borders(xlEdgeTop).LineStyle = xlContinuous
Target.Offset(0, 3).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
Target.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
Target.Offset(0, 3).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
Target.Offset(0, 3).Borders(xlEdgeRight).LineStyle = xlContinuous
Target.Offset(0, 3).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
Range("C" & i).BorderAround ColorIndex:=3
End If
ElseIf Not Intersect(Target, Range("M:M,R:R,W:W,AB:AB,AF:AF")) Is Nothing Then
If Target = vbNullString Then
Target.Offset(0, 1) = vbNullString
Target.Offset(0, 0).Borders(xlEdgeTop).LineStyle = xlContinuous
Target.Offset(0, 0).Borders(xlEdgeBottom).LineStyle = xlContinuous
Target.Offset(0, 0).Borders(xlEdgeRight).LineStyle = xlContinuous
Target.Offset(0, 0).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
Target.Offset(0, 0).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
Target.Offset(0, 0).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
Target.Offset(0, 0).Borders(xlEdgeLeft).Color = RGB(255, 0, 0)
Target.Offset(0, 1).Borders(xlEdgeTop).LineStyle = xlContinuous
Target.Offset(0, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
Target.Offset(0, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
Target.Offset(0, 1).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
Target.Offset(0, 1).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
Target.Offset(0, 1).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
Else
Target.Offset(0, 1) = Date
Target.Offset(0, 0).Borders(xlEdgeTop).LineStyle = xlNone
Target.Offset(0, 0).Borders(xlEdgeBottom).LineStyle = xlNone
Target.Offset(0, 0).Borders(xlEdgeRight).Color = RGB(0, 0, 0)
Target.Offset(0, 0).Borders(xlEdgeLeft).Color = RGB(0, 0, 0)
Target.Offset(0, 1).Borders(xlEdgeTop).LineStyle = xlNone
Target.Offset(0, 1).Borders(xlEdgeBottom).LineStyle = xlNone
Target.Offset(0, 1).Borders(xlEdgeRight).LineStyle = xlNone
Target.Offset(0, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
End If
End If
If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
If Target.Value = "Y" Or "y" Then
If Range("A" & i).Font.Color = RGB(255, 0, 0) Then
AnswerYes = MsgBox("OReally?", vbQuestion + vbYesNo, "User Repsonse")
If AnswerYes = vbYes Then
Exit Sub
Else
Exit Sub
End If
End If
End If
End sub