Я пытаюсь найти, что не так с кодом, но я не могу. В первом операторе if я хочу сказать, что движение ADD, и если 3 ячейки листа 1 (DataEntry) равны 3 ячейкам sheet2 (Catalog), тогда не делайте запись, если они не равны, тогда сделайте это. В обеих ситуациях это делает запись, и из-за этого у меня есть дубликаты. Кто-нибудь может помочь?
ps: если я удаляю elseif, и у меня есть только если тогда он показывает сообщение.
Обновлено (24.01.2020) : Вчера все работало нормально. И через несколько минут go я понял, что когда я набираю греческое слово в ячейках A, B, C, например, «φίλτρο» «νερού» «κ.π.» Excel не признает. Даже если кажется, что пытается ввести данные на каталожный лист, ничего не происходит и ничего не появляется. Хотя странные вещи происходят. Иногда все работало нормально (кроме греков), иногда появлялись неправильные окна сообщений. И продолжайте работать и отображать сообщение, даже если я нажму кнопку ОК, а затем Excel вылетает. «У меня закружилась голова», и я не могу понять, ясно.
Sub AddChange()
Dim t1, t2, t3, t4, t5, t6
Dim t10, t11, t12, t13, t14, t15
Dim t18, t19, t20, t21, t22, t23
Dim arrayData As Variant
Dim arrayData2 As Variant
Dim cleanData As Range
Dim keli As Range
Dim baseSheet As Object
Dim formaSheet As Object
Dim Stock As Object
Dim meter As Long
Dim meter2 As Long
Dim Movement As String
Dim i As Integer
Set Stock = Sheets("StockMovements")
Set baseSheet = Sheets("Catalogue")
Set formaSheet = Sheets("DataEntry")
Set t1 = formaSheet.Range("A6")
Set t2 = formaSheet.Range("B6")
Set t3 = formaSheet.Range("C6")
Set t4 = formaSheet.Range("D6")
Set t5 = formaSheet.Range("E6")
Set t6 = formaSheet.Range("F6")
Set t10 = baseSheet.Range("A2")
Set t11 = baseSheet.Range("B2")
Set t12 = baseSheet.Range("C2")
Set t13 = baseSheet.Range("D2")
Set t14 = baseSheet.Range("E2")
Set t15 = baseSheet.Range("F2")
Set t18 = Stock.Range("B2")
Set t19 = Stock.Range("C2")
Set t20 = Stock.Range("D2")
Set t21 = Stock.Range("E2")
Set t22 = Stock.Range("F2")
Set t23 = Stock.Range("G2")
Movement = Range("G6").Value
If Movement Like "ADD NEW" Then
For i = 2 To 10000
With Worksheets("DataEntry")
If (UCase(Trim(Worksheets("DataEntry").Cells(6, "A"))) = UCase(Trim(Worksheets("Catalogue").Cells(i, "A")))) _
And (UCase(Trim(Worksheets("DataEntry").Cells(6, "B"))) = UCase(Trim(Worksheets("Catalogue").Cells(i, "B")))) _
And (UCase(Trim(Worksheets("DataEntry").Cells(6, "C"))) = UCase(Trim(Worksheets("Catalogue").Cells(i, "C")))) _
Then
MsgBox "The product already exists! Select change and continue.", vbOKCancel
ElseIf Not (UCase(Trim(Worksheets("DataEntry").Cells(6, "A"))) = UCase(Trim(Worksheets("Catalogue").Cells(i, "A")))) _
And (UCase(Trim(Worksheets("DataEntry").Cells(6, "B"))) = UCase(Trim(Worksheets("Catalogue").Cells(i, "B")))) _
And (UCase(Trim(Worksheets("DataEntry").Cells(6, "C"))) = UCase(Trim(Worksheets("Catalogue").Cells(i, "C")))) _
Then
meter = Application.WorksheetFunction.CountA(baseSheet.Range("A:A"))
meter2 = Application.WorksheetFunction.CountA(Stock.Range("A:A"))
arrayData = VBA.Array(t1, t2, t3, t4, t5, t6)
'arrayData2 = VBA.Array(t1, t2, t3, t4, t5, t6)
Set cleanData = Union(t1, t2, t3, t4, t5)
With cleanData.Cells
Set keli = .Find(What:="*", LookIn:=xlValues)
If keli Is Nothing Then
GoTo telos
End If
End With
baseSheet.Cells(meter + 1, 1).Resize(, 6) = arrayData
Stock.Cells(meter2 + 1, 1).Resize(, 6) = arrayData
cleanData.ClearContents
End If
End With
Next i
End If
If Movement Like "CHANGE" Then
For i = 2 To 10000
With Worksheets("DataEntry")
If (UCase(Trim(Worksheets("DataEntry").Cells(6, "A"))) = UCase(Trim(Worksheets("Catalogue").Cells(i, "A")))) _
And (UCase(Trim(Worksheets("DataEntry").Cells(6, "B"))) = UCase(Trim(Worksheets("Catalogue").Cells(i, "B")))) _
And (UCase(Trim(Worksheets("DataEntry").Cells(6, "C"))) = UCase(Trim(Worksheets("Catalogue").Cells(i, "C")))) _
Then
MsgBox "Do you want to continue?", vbOKCancel
Worksheets("Catalogue").Cells(i, "A") = Worksheets("DataEntry").Cells(6, "A")
Worksheets("Catalogue").Cells(i, "B") = Worksheets("DataEntry").Cells(6, "B")
Worksheets("Catalogue").Cells(i, "C") = Worksheets("DataEntry").Cells(6, "C")
Worksheets("Catalogue").Cells(i, "D") = Worksheets("DataEntry").Cells(6, "D")
Worksheets("Catalogue").Cells(i, "E") = Worksheets("DataEntry").Cells(6, "E")
Worksheets("Catalogue").Cells(i, "F") = Worksheets("DataEntry").Cells(6, "F")
ElseIf Not (UCase(Trim(Worksheets("DataEntry").Cells(6, "A"))) = UCase(Trim(Worksheets("Catalogue").Cells(i, "A")))) _
And (UCase(Trim(Worksheets("DataEntry").Cells(6, "B"))) = UCase(Trim(Worksheets("Catalogue").Cells(i, "B")))) _
And (UCase(Trim(Worksheets("DataEntry").Cells(6, "C"))) = UCase(Trim(Worksheets("Catalogue").Cells(i, "C")))) _
Then
MsgBox "The product does not exist. Select add new.", vbOKCancel
Set cleanData = Union(t1, t2, t3, t4, t5)
With cleanData.Cells
Set keli = .Find(What:="*", LookIn:=xlValues)
If keli Is Nothing Then
GoTo telos
End If
End With
cleanData.ClearContents
End If
End With
Next i
End If
telos:
End Sub
Я набираю новый предмет и нажимаю кнопку «Изменить», должно появиться сообщение «Товар не существует. Выберите« Добавить новый ».» Оно показывает это сообщение, а затем всплывает и вылетает другое сообщение. 
Нечто подобное произошло, когда я пытаюсь добавить уже существующий продукт. Сначала показывает правильное сообщение, а затем показывает другое и вылетает.