Private Sub TextBox1_Change()
 On Error GoTo ErrorHandler
    Dim allowedValues As Variant
    Dim inputValue  As String
    Dim matchFound  As Boolean
    Dim i           As Long

    allowedValues = Array("Значени1", "Значени2", "Значени3", "Значени4")
    inputValue = Me.TextBox1.Value
    matchFound = False

    For i = LBound(allowedValues) To UBound(allowedValues)

        If inputValue = allowedValues(i) Then
            matchFound = True
            Exit For
        End If

    Next i

    If matchFound Then
        Me.Hide

        Select Case inputValue
            Case "1324"
                UserForm1.Qwerty.Caption = "Значени1"
            Case "5221"
                UserForm1.Qwerty.Caption = "Значени2"
            Case "5322"
                UserForm1.Qwerty.Caption = "Значени3"
            Case "4123"
                UserForm1.Qwerty.Caption = "Значени4"
        End Select

        Application.OnTime Now, "ТЕРМИНАЛ"
        Unload Me
    End If

    Exit Sub
ErrorHandler:
    MsgBox "Произошла ошибка: " & Err.Description

    With Workbooks(TargetBook)
       
       
        .Close savechanges:=False
    End With

End

 
  
End Sub

Sub SubtractAllQuantities()
    Dim sheet1      As Worksheet: Set sheet1 = ThisWorkbook.Sheets("КАРТОЧКА ТОВАРА")
    Dim sheet2      As Worksheet: Set sheet2 = ThisWorkbook.Sheets("СИСТЕМА")
    Dim sheet3      As Worksheet: Set sheet3 = ThisWorkbook.Sheets("РЕЕСТР ПРОДАЖ")
    Dim lastRow1    As Long
    Dim rng As Range, X As Long
    lastRow1 = sheet1.Cells(Rows.Count, "A").End(xlUp).Row
    Dim lastRow2    As Long
    lastRow2 = sheet2.Cells(Rows.Count, "A").End(xlUp).Row
    Dim lastRow3    As Long
    lastRow3 = sheet3.Cells(Rows.Count, "E").End(xlUp).Row
    Dim I As Long, J As Long, W As Long, Y As Long
    Application.ScreenUpdating = False
    ' пройти по каждому ID номеру на втором листе
    For I = 2 To lastRow2

        ' пройти по каждому ID номеру на первом листе
        For J = 3 To lastRow1

            ' если ID номера совпадают, вычесть количество на втором листе из количества на первом листе
            If sheet1.Cells(J, "A").Value = sheet2.Cells(I, "A").Value And sheet2.Cells(I, "E").Value < sheet1.Cells(J, "D").Value And sheet2.Cells(I, "c").Value = sheet1.Cells(J, "H").Value Then
            sheet1.Cells(J, "C").Value = sheet1.Cells(J, "C").Value - sheet2.Cells(I, "D").Value * sheet1.Cells(J, "E").Value
            Else
            If sheet1.Cells(J, "A").Value = sheet2.Cells(I, "A").Value Then
                sheet1.Cells(J, "C").Value = sheet1.Cells(J, "C").Value - sheet2.Cells(I, "D").Value
                 If sheet1.Cells(J, "C").Value <> 0.001 Then
                sheet1.Cells(J, "C").Value = "0"
                End If
               
                Exit For
                
            End If
End If
        Next J

    Next I
    For X = 3 To lastRow1
    If sheet1.Cells(X, "C").Value < 0.001 Then
                sheet1.Cells(X, "C").Value = "0"
                End If
               Next X
               
     For W = 3 To lastRow1
     For Y = 4 To lastRow3
     If sheet1.Cells(W, "A").Value = sheet3.Cells(Y, "E").Value Then
     sheet3.Cells(Y, "J").Value = (sheet1.Cells(W, "D").Value - sheet1.Cells(W, "I").Value) * sheet3.Cells(Y, "G").Value
     Exit For
     End If
     Next Y
     Next W
    
  
    Application.ScreenUpdating = True
End Sub

If Range("A2").Value = Me.TextBox1.Text And Range("C2").Value = Me.TextBox4.Text Then
 MsgBox "l"
 Exit Sub
 Else
 If Range("a3").Value = Me.TextBox1.Text And Range("C3").Value = Me.TextBox4.Text Then
 MsgBox "l"
 Exit Sub
 Else
 If Range("a4").Value = Me.TextBox1.Text And Range("C4").Value = Me.TextBox4.Text Then
 MsgBox "l"
 Exit Sub
 Else
 If Range("a5").Value = Me.TextBox1.Text And Range("C5").Value = Me.TextBox4.Text Then
 MsgBox "l"
 Exit Sub
 Else
   Nrow = .Range("A9999").End(xlUp).Row + 1
    Sheets("СИСТЕМА").Range("L3").Value = AvailRow
    .Cells(Nrow, "A") = Me.TextBox1.Value
    .Cells(Nrow, "B") = Me.Label1
    .Cells(Nrow, "C") = Me.TextBox4
   

AvailRow = Sheets("СИСТЕМА").Range("B999").End(xlUp).Row + 1
If Me.TextBox1 = "" Then Exit Sub
Set IM = Sheets("КАРТОЧКА ТОВАРА").Range("A:A").Find(Me.TextBox1.Value, , xlValues, xlWhole)
If IM Is Nothing Then
'do nothing
Else
'Add Itm in Boxes

IMROW = IM.Row
If Sheets("КАРТОЧКА ТОВАРА").Range("G" & IMROW).Value <= Me.TextBox3.Text + 0 Then
введено.Show

Exit Sub
Else
With Sheets("СИСТЕМА")
nrow = .Range("A9999").End(xlUp).Row + 1
For Each cc In .Range("A2:A100")
If cc = Me.TextBox1.Text = True Then UserForm5.Show
Exit For
Exit Sub
Next
 If cc = Me.TextBox1.Text = False Then
 
   
    Sheets("СИСТЕМА").Range("L3").Value = AvailRow
    .Cells(nrow, "A") = Me.TextBox1.Value
    .Cells(nrow, "B") = Me.Label1
    .Cells(nrow, "C") = Sheets("КАРТОЧКА ТОВАРА").Range("F" & IMROW).Value
   
Sheets("СИСТЕМА").Cells(nrow, "D") = Sheets("КАРТОЧКА ТОВАРА").Range("e" & IMROW).Value * Val(Me.TextBox3)
    
    .Cells(nrow, "D") = Me.TextBox3.Value
    .Cells(nrow, "E") = Sheets("КАРТОЧКА ТОВАРА").Range("D" & IMROW) * Sheets("КАРТОЧКА ТОВАРА").Range("e" & IMROW).Value
    .Cells(nrow, "F") = .Cells(nrow, "D") * .Cells(nrow, "E")
    On Error Resume Next
UserForm1.ListBox1.Column(2).TextAlign (1)
    UserForm1.ListBox1.RowSource = "ITTEM_NAME"
   
UserForm1.Label34 = Sheets("СИСТЕМА").Range("I1").Value
End If

Private Sub CommandButton1_Click()

AvailRow = Sheets("СИСТЕМА").Range("B999").End(xlUp).Row + 1
If Me.TextBox1 = "" Then Exit Sub
Set ITM = Sheets("КАРТОЧКА ТОВАРА").Range("A:A").Find(Me.TextBox1.Value, , xlValues, xlWhole)
If ITM Is Nothing Then
'do nothing
Else
'Add Itm in Boxes

ITMROW = ITM.Row
If Sheets("КАРТОЧКА ТОВАРА").Range("G" & ITMROW).Value <= Me.TextBox3.Text + 0 Then
введено.Show

Else
With Sheets("СИСТЕМА")
    newrow = .Range("A9999").End(xlUp).Row + 1
  Sheets("СИСТЕМА").Range("L3").Value = AvailRow
    .Cells(newrow, "A") = Me.TextBox1.Value
    .Cells(newrow, "B") = Me.Label1
    .Cells(newrow, "C") = Sheets("КАРТОЧКА ТОВАРА").Range("F" & ITMROW).Value
   
Sheets("СИСТЕМА").Cells(newrow, "D") = Sheets("КАРТОЧКА ТОВАРА").Range("e" & ITMROW).Value * Val(Me.TextBox3)
    
    .Cells(newrow, "D") = Me.TextBox3.Value
    .Cells(newrow, "E") = Sheets("КАРТОЧКА ТОВАРА").Range("D" & ITMROW) * Sheets("КАРТОЧКА ТОВАРА").Range("e" & ITMROW).Value
    .Cells(newrow, "F") = .Cells(newrow, "D") * .Cells(newrow, "E")
    On Error Resume Next
UserForm1.ListBox1.Column(2).TextAlign (1)
    UserForm1.ListBox1.RowSource = "ITTEM_NAME"
   
UserForm1.Label34 = Sheets("СИСТЕМА").Range("I1").Value
 Unload Me
 UserForm1.ItmScan.SetFocus
End With
End If
End If
End Sub

Private Sub CommandButton5_Click()
'   ---------------------------------
    Dim i&, j&, arr()
'   ---------------------------------
    For i = 0 To Me.ListBox1.ListCount - 1
        If Not Me.ListBox1.Selected(i) Then
            ReDim Preserve arr(j)
            arr(j) = Me.ListBox1.List(i)
            j = j + 1
        End If
    Next i
    Me.ListBox1.Clear
    Range("система").ClearContents
    If j = 0 Then Exit Sub
    Me.ListBox1.List = arr
    Range("система").Resize(j).Value = Application.Transpose(arr)
End Sub