Userform: Duplicate Entries where two cells are the same

[Dalricsin8]

Hello,

I would really appreciate any help that can be given. I have created a userform where I can track missed scan labels from my production team. I have 6 text boxes per ticket I need to fill in the userform. (all for different tracking purposes) What I need the userform to do is only check that two of the texts boxes are not a complete match to another entry when I hit enter. I attempted it and with a countifs but and I don't get error but it still enters duplicates. The columns I need to check are B and D. I am not very experienced so the code may be sloppy. Thank you for taking a look and if you need any more info please let me know.

Private Sub Enter_Click()

Dim emptyRow As Long

    Sheets(1).Activate
    
    emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1


If Len(MissedScanLabelsReportUserform.fsap.Value) = 0 Then
    MsgBox "SAP Number was left blank.", vbOKOnly, "Error"
    MissedScanLabelsReportUserform.fsap.SetFocus
    
Exit Sub
End If
If Len(MissedScanLabelsReportUserform.forder.Value) = 0 Then
    MsgBox "Production Order was left blank.", vbOKOnly, "Error"
    MissedScanLabelsReportUserform.forder.SetFocus
Exit Sub
End If
If Len(MissedScanLabelsReportUserform.fqty.Value) = 0 Then
    MsgBox "Quantity was left blank.", vbOKOnly, "Error"
    MissedScanLabelsReportUserform.fqty.SetFocus
Exit Sub
End If
If Len(MissedScanLabelsReportUserform.fplt.Value) = 0 Then
    MsgBox "Pallet Nummber was left blank.", vbOKOnly, "Error"
    MissedScanLabelsReportUserform.fqty.SetFocus
Exit Sub
End If
If Len(MissedScanLabelsReportUserform.fshift.Value) = 0 Then
    MsgBox "The Shift was left blank.", vbOKOnly, "Error"
    MissedScanLabelsReportUserform.fqty.SetFocus
Exit Sub
End If
If Len(MissedScanLabelsReportUserform.fdate.Value) = 0 Then
    MsgBox "The Date was left blank.", vbOKOnly, "Error"
    MissedScanLabelsReportUserform.fqty.SetFocus
Exit Sub
End If
   
If Application.WorksheetFunction.CountIfs(Sheets(1).Range("B:B"), forder.Value > 0, Sheets(1).Range("D:D"), fplt.Value > 0) Then
   MsgBox ("Already exists in the database; cannot be entered again")
   Exit Sub
Else
    Sheets(1).Cells(emptyRow, 1).Value = fsap.Value
    Sheets(1).Cells(emptyRow, 2).Value = forder.Value
    Sheets(1).Cells(emptyRow, 3).Value = fqty.Value
    Sheets(1).Cells(emptyRow, 4).Value = fplt.Value
    Sheets(1).Cells(emptyRow, 5).Value = fshift.Value
    Sheets(1).Cells(emptyRow, 6).Value = fdate.Value
End If
    
   
Call UserForm_Initialize
    
End Sub

 

[dmt32]

Hi,
untested - try this update to your code

Option Base 1
Private Sub Enter_Click()
    Dim i As Integer
    Dim emptyRow As Long
    Dim ws As Worksheet
    Dim msg As String
    Dim arr() As Variant, ControlsArray As Variant
    
    Set ws = ThisWorkbook.Worksheets(1)
    emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
    ControlsArray = Array("fsap", "forder", "fqty", "fplt", "fshift", "fdate")
    
    ReDim arr(UBound(ControlsArray))
    
    For i = 1 To UBound(ControlsArray)
        With Me.Controls(ControlsArray(i))
        If Len(.Value) = 0 Then
            msg = Choose(i, "SAP Number", "Production Order", "Quantity", "Pallet Nummber", "The Shift", "The Date")
            MsgBox msg & " was left blank.", 16, "Entry Required"
            .SetFocus
            Exit Sub
        Else
            If IsDate(.Text) Then arr(i) = DateValue(.Value) Else arr(i) = .Value
        End If
        End With
    Next i
    If Not IsMatch(ws, arr(2), arr(4)) Then ws.Cells(emptyRow, 1).Resize(, UBound(arr)).Value = arr
End Sub


Function IsMatch(ByVal sh As Object, ParamArray Values() As Variant) As Boolean
    Dim FoundRecord As Range
    Dim FirstAddress  As String
    Dim SearchRecord As Variant
    SearchRecord = Values(0)
    Set FoundRecord = sh.Columns(2).Find(SearchRecord, Lookat:=xlWhole, LookIn:=xlValues)
    If Not FoundRecord Is Nothing Then
    FirstAddress = FoundRecord.Address
    Do
     IsMatch = CBool(CStr(FoundRecord.Offset(, 2).Value) = CStr(Values(1)))
     If IsMatch Then MsgBox SearchRecord & Chr(10) & _
     "Already exists in the database cannot be entered again", 48, "Record Exists": Exit Function
     Set FoundRecord = sh.Columns(2).FindNext(FoundRecord)
    Loop Until FirstAddress = FoundRecord.Address
    End If
End Function

Note Option Base 1 statement which MUST be at very TOP of your forms code page OUTSIDE any procedure.

Dave

 

[Dalricsin8]

Dave,

Thank you so much for the quick response. It works exactly as I hoping for. Have a great day.

Hi,
untested - try this update to your code

Option Base 1
Private Sub Enter_Click()
    Dim i As Integer
    Dim emptyRow As Long
    Dim ws As Worksheet
    Dim msg As String
    Dim arr() As Variant, ControlsArray As Variant
    
    Set ws = ThisWorkbook.Worksheets(1)
    emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
    ControlsArray = Array("fsap", "forder", "fqty", "fplt", "fshift", "fdate")
    
    ReDim arr(UBound(ControlsArray))
    
    For i = 1 To UBound(ControlsArray)
        With Me.Controls(ControlsArray(i))
        If Len(.Value) = 0 Then
            msg = Choose(i, "SAP Number", "Production Order", "Quantity", "Pallet Nummber", "The Shift", "The Date")
            MsgBox msg & " was left blank.", 16, "Entry Required"
            .SetFocus
            Exit Sub
        Else
            If IsDate(.Text) Then arr(i) = DateValue(.Value) Else arr(i) = .Value
        End If
        End With
    Next i
    If Not IsMatch(ws, arr(2), arr(4)) Then ws.Cells(emptyRow, 1).Resize(, UBound(arr)).Value = arr
End Sub


Function IsMatch(ByVal sh As Object, ParamArray Values() As Variant) As Boolean
    Dim FoundRecord As Range
    Dim FirstAddress  As String
    Dim SearchRecord As Variant
    SearchRecord = Values(0)
    Set FoundRecord = sh.Columns(2).Find(SearchRecord, Lookat:=xlWhole, LookIn:=xlValues)
    If Not FoundRecord Is Nothing Then
    FirstAddress = FoundRecord.Address
    Do
     IsMatch = CBool(CStr(FoundRecord.Offset(, 2).Value) = CStr(Values(1)))
     If IsMatch Then MsgBox SearchRecord & Chr(10) & _
     "Already exists in the database cannot be entered again", 48, "Record Exists": Exit Function
     Set FoundRecord = sh.Columns(2).FindNext(FoundRecord)
    Loop Until FirstAddress = FoundRecord.Address
    End If
End Function

Note Option Base 1 statement which MUST be at very TOP of your forms code page OUTSIDE any procedure.

Dave

 

[dmt32]

Dave,

Thank you so much for the quick response. It works exactly as I hoping for. Have a great day.

Most welcome glad solution helped you.

Dave