Option Explicit
Sub NTKTNN()
Dim sArr(), dArr(), CusName, ProCat, fDate As Long, tDate As Long, Profit As String, Bo As Boolean
Dim i As Long, J As Long, K As Long
Application.ScreenUpdating = False
With Sheets("Orders")
sArr = .Range("A2:J" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With
With Sheets("Filter")
CusName = Split(";" & .Range("B1").Value, ";")
ProCat = Split(";" & .Range("B2").Value, ";")
fDate = .Range("D1").Value
tDate = .Range("D2").Value
Profit = .Range("E2").Value
ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
For i = 1 To UBound(sArr, 1)
For J = 1 To UBound(CusName)
If InStr(1, sArr(i, 8), CusName(J), 1) > 0 Then Bo = True: Exit For
Next
If Bo = False Then GoTo Next_I Else Bo = False
For J = 1 To UBound(ProCat)
If InStr(1, sArr(i, 10), ProCat(J), 1) > 0 Then Bo = True: Exit For
Next
If Bo = False Then GoTo Next_I Else Bo = False
If fDate > 0 And tDate > 0 Then
If sArr(i, 2) >= fDate And sArr(i, 2) <= tDate Then Bo = True
If Bo = False Then GoTo Next_I Else Bo = False
End If
If Profit <> "" Then
If Evaluate(sArr(i, 6) * 1 & Profit) Then Bo = True
If Bo = False Then GoTo Next_I Else Bo = False
End If
K = K + 1
For J = 1 To UBound(sArr, 2)
dArr(K, J) = sArr(i, J)
Next
Next_I:
Next
If K Then
.Range("A4:J10000").ClearContents
.Range("A4").Resize(K, UBound(sArr, 2)) = dArr
End If
End With
Application.ScreenUpdating = True
End Sub