Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
    If Target = "" Then Exit Sub
    If Not Intersect(Target, Range("A2")) Is Nothing Then
        Application.EnableEvents = False
        Set Rng = Range("A3:A100").Find(what:=Target, LookIn:=xlValues, lookAt:=xlWhole)
        If Not Rng Is Nothing Then
            MsgBox "Вы вводите данные, которые уже имеются в excel", 48, "Ощибка!"
            Target = ""
        End If
    End If
    Application.EnableEvents = True
End Sub

    Private Sub Worksheet_Change(ByVal Target As Range)
Dim lReply As Long
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Address = "$A$2" Then
     If IsEmpty(Target) Then Exit Sub
       If WorksheetFunction.CountIf(Range("company"), Target) = 0 Then
          lReply = MsgBox("Добавить новую компанию " & _
                         Target & " в список?", vbYesNo + vbQuestion)
          If lReply = vbYes Then
              Range("company").Cells(Range("company").Rows.Count + 1, 1) = Target
          End If
       End If
     End If
End Sub