Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("W:W")) Is Nothing And Target.Cells.Count = 1 Then
        Application.EnableEvents = False
        newval = Target
        Application.Undo
        oldval = Target
        If IsError(Application.WorksheetFunction.Match(newval, Range(Replace(Target.Validation.Formula1, "=", "")), 0)) Then
            Target = newval
        Else
            If Len(oldval) <> 0 And oldval <> newval Then
                Target = Target & ";" & Chr(10) & " " & newval
            Else
                Target = newval
            End If
        End If
        If Len(newval) = 0 Then Target.ClearContents
        Application.EnableEvents = True
    End If
End Sub