Private
Sub
Worksheet_Change(
ByVal
Target
As
Range)
Dim
Oldvalue
As
Variant
Dim
Newvalue
As
Variant
Application.EnableEvents =
True
On
Error
GoTo
Exitsub
If
Not
Intersect(Target, Range(
"C2"
))
Is
Nothing
Then
If
Target.SpecialCells(xlCellTypeAllValidation)
Is
Nothing
Then
GoTo
Exitsub
Else
If
Target.Value =
""
Then
GoTo
Exitsub
Application.EnableEvents =
False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If
Oldvalue =
""
Then
Target.Value = Newvalue
Else
If
InStr(1, Oldvalue, Newvalue) = 0
Then
Target.Value = Oldvalue &
"; "
& Newvalue
Else
Target.Value = Oldvalue
End
If
End
If
End
If
End
If
Exitsub:
Application.EnableEvents =
True
End
Sub