[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] Worksheet_Change([COLOR=darkblue]ByVal[/COLOR] Target [COLOR=darkblue]As[/COLOR] Range)
[COLOR=darkblue]Dim[/COLOR] oldVal [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
[COLOR=darkblue]Dim[/COLOR] newVal [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
[B] [COLOR=darkblue]If[/COLOR] Target.Count > 1 [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
[COLOR=darkblue]If[/COLOR] Intersect(Range("Q8,K11,K14"), Target) [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR][/B]
[COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] ReEnable
Application.EnableEvents = [COLOR=darkblue]False[/COLOR]
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
[COLOR=darkblue]If[/COLOR] oldVal <> "" And newVal <> "" [COLOR=darkblue]Then[/COLOR]
Target.Value = oldVal & ", " & newVal
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
ReEnable:
Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
[COLOR=darkblue]If[/COLOR] Err.Number <> 0 [COLOR=darkblue]Then[/COLOR] MsgBox Err.Description, vbCritical, "Error " & Err.Number
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]