Private Sub Worksheet_Change(ByVal Target As Range)
                    Dim Oldvalue As String
                    Dim Newvalue As String
                    On Error GoTo Exitsub
                    If Not Intersect(Target, Range("H2:H500")) Is Nothing Then
                        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
                Exitsub:
                    Application.EnableEvents = True
                End Sub