Private Sub CommandButton1_Click()
Dim f As Boolean
If IsDate(txtFillingTime.Value) = False Then
MsgBox "Введите время согласно шаблону ЧЧ:ММ"
Exit Sub
End If

Dim c, i
For Each c In Me.Controls
If TypeName(c) = "TextBox" Then
If c.name <> "TxtComment" Then
If c.Value = "" Then
MsgBox "Заполните все поля!"
Exit Sub
End If
End If
End If
Next c

Dim yeast, filtrationFlow, BBTNumber, consumptionPVPP, consumptionDE, posStr As Integer
Dim pressureEntranceS, pressureEntranceE, Turbidity25, Turbidity90, pressureDifTrap, Density, pressureEntrance As Double
Dim beerGrade, fillingTime, typeOfCapacity, comment As String
beerGrade = ComboBox1.Text
yeast = txtYeast.Value
Density = TextBox_Density
pressureEntranceS = txtPressureEntrance.Value
pressureEntranceE = TextBox1.Value
pressureEntrance = pressureEntranceS - pressureEntranceE
Turbidity25 = txtTurbidity25.Value
Turbidity90 = txtTurbidity90.Value
consumptionPVPP = txtConsumptionPVPP.Value
consumptionDE = txtConsumptionDE.Value
filtrationFlow = TextBox2.Value
BBTNumber = txtBBTNumber.Value
pressureDifTrap = txtPressureDifTrap.Value
fillingTime = txtFillingTime.Value
If TxtComment = "Комментарий" Then
comment = ""
Else
comment = TxtComment
End If
If optCCT.Value = True Then
typeOfCapacity = "ЦКТ"
Else
typeOfCapacity = "Лагерный танк"
End If
posStr = Cells(Rows.Count, 2).End(xlUp).Row + 1
Cells(posStr, "B") = beerGrade
Cells(posStr, "C") = fillingTime
Cells(posStr, "D") = DatePart("h", Time) & ":" & DatePart("n", Time)
Cells(posStr, "E") = typeOfCapacity
Cells(posStr, "G") = txtNumber.Value
Cells(posStr, "H") = yeast
Cells(posStr, "I") = Density
Cells(posStr, "J") = pressureEntranceS
Cells(posStr, "K") = pressureEntranceE
Cells(posStr, "L") = pressureEntrance
Cells(posStr, "N") = Turbidity25
Cells(posStr, "P") = Turbidity90
Cells(posStr, "Q") = consumptionPVPP
Cells(posStr, "R") = consumptionDE
Cells(posStr, "S") = filtrationFlow
Cells(posStr, "T") = BBTNumber
Cells(posStr, "U") = pressureDifTrap
Cells(posStr, "V") = comment

Dim Lastrow As Long, str As String
Dim Dict As Object, key, item, j, k, arr()

Set Dict = CreateObject("Scripting.Dictionary")
Lastrow = Cells(Rows.Count, 2).End(xlUp).Row

For j = 19 To Lastrow - 1
key = Cells(j, 5) & " " & Cells(j, 7)
If Not Dict.exists(key) Then Dict.Add key, Array(Cells(j, 2), Cells(j, 5), Cells(j, 7), Cells(j, 9))
Next j
ReDim arr(1 To 4)
arr(1) = beerGrade
arr(2) = typeOfCapacity
arr(3) = txtNumber.Value
arr(4) = Density
str = typeOfCapacity & " " & txtNumber.Value
If Not Dict.exists(str) Then
Lastrow = Cells(Rows.Count, 28).End(xlUp).Row
If IsEmpty(Cells(19, 28)) Then
Cells(Lastrow + 1, 28).Resize(1, UBound(arr)) = arr
Else
Lastrow = Cells(Rows.Count, 28).End(xlUp).Row
Cells(Lastrow + 1, 28).Resize(1, UBound(arr)) = arr
End If
End If

[color=red]'Дублирование данных VBA[/color]

posStr = Sheets("База данных").Cells(Rows.Count, 2).End(xlUp).Row + 1
Cells(posStr, "A") = Range("D10")
Cells(posStr, "B") = Range("D11")
Cells(posStr, "C") = beerGrade
Cells(posStr, "D") = fillingTime
Cells(posStr, "E") = DatePart("h", Time) & ":" & DatePart("n", Time)
Cells(posStr, "F") = typeOfCapacity
Cells(posStr, "G") = txtNumber.Value
Cells(posStr, "H") = yeast
Cells(posStr, "I") = Density
Cells(posStr, "J") = pressureEntranceS
Cells(posStr, "K") = pressureEntranceE
Cells(posStr, "L") = pressureEntrance
Cells(posStr, "M") = Turbidity25
Cells(posStr, "N") = Turbidity90
Cells(posStr, "O") = consumptionPVPP
Cells(posStr, "P") = consumptionDE
Cells(posStr, "Q") = filtrationFlow
Cells(posStr, "R") = BBTNumber
Cells(posStr, "S") = pressureDifTrap
Cells(posStr, "T") = comment

Unload Me
End Sub