Make sure textbox values don't match a record in a table row vba

[TheSecretaryJen]

Hi all,

I have a userform I have built to input training records for my company. I want to prevent users from accidentally putting in a duplicate record.

The record table is called "TrainingRecords." It has several columns of data, but I only want to check four columns: "Employee Name" (Column 1), "Start Date" (Column 10), "End Date" (Column 11), and "Concatenated Training" (Column 16).

Here is how the form works: the user inputs the start date and end date in textboxes on the userform, called "DateInputStart" and "DateInputEnd" respectively. The Concatenated Training value goes into a textbox called "Training".

Here is where it gets seriously complicated: the user can put in up to fifty names at once. I have fifty labels that are set as invisible on the userform when it initializes. Each of these labels is called "Name1," "Name2," etc., all the way up to "Name50." When the user wants to input a name, they choose from a drop-down list in a combobox and click a command button. This command button increases the Name Count number (in an invisible textbox) by one, and then takes the resulting number and chooses the label accordingly. This label then becomes visible and shows that name as a caption. I.e., when a user chooses his/her first name and clicks the button, the count increases from 0 to 1, and then the code knows to put that name into the "Name1" label caption. It does this up to 50 times, and then if they try to add another name, it informs them that they can't.

SO. This duplicate-check code has to take each one of the used label captions, find those names in Column 1 of my table, then check the adjacent cells in Columns 10, 11 and 16 to see if they match the values in the three aforementioned textboxes. If a complete match is found, I want a message box to pop up and tell the user that they are trying to enter a duplicate record.

I have tried multiple ways to solve this, and I am now totally stumped to the point that I don't even have example code to show you guys. I'm also afraid that having to check up to fifty names is going to seriously slow down the code. Any thoughts or advice?

 

[TheSecretaryJen]

UPDATE: I have figured out part of it, at least.

First of all, I misspoke regarding how the names are stored when the user chooses them. Here is what actually happens: On the userform, they click a button to insert a name, and the label is actually dynamically created with the chosen name as the caption. The code names the label "Name" and whatever the count is, so "Name1", "Name2", etc. At the same time, that same name they chose is added to a table called "TempName" on another sheet. Then when they save the records, the code copies the names from the table rather than the label captions, since it is super difficult to do anything to controls added at runtime (speaking from experience). I could probably go back and change this to the premise I originally stated (labels are invisible until needed), but I really don't want to do that unless it's necessary because what I have now for recording training works really well.

Now that I've explained all that, here is some code I have come up with that works, at least partially. It searches the training records, finds instances of the names in the TempName list, and then pops up a message box with the cell addresses of occurrences of those names. It does this for every name in the TempName list, and then stops. If it finds no instances of the name in the records, it pops up a message box saying the names weren't found.

This does work, so I have successfully figured out how to find duplicate names. Now I'm trying to figure out how to use offsets to find the dates and training that correspond with these found names, and see if they match the values on the userform. No luck so far.

This is the code I have to record training currently, with the addition of the name finding code.

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Cell As Range
Dim q As Integer
Dim lRow As Long
Dim tbl As ListObject
Dim Row As ListRow
Dim oRange As Range
Dim aCell As Range
Dim bCell As Range
Dim SearchName As Range
Dim FoundAt As String
Dim x As Integer
Dim z As Integer

Application.ScreenUpdating = False
Application.EnableEvents = False

Set ws1 = ActiveWorkbook.Worksheets("Training Records")
Set ws2 = ActiveWorkbook.Worksheets("Temp Name List")
lRow = ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Set tbl = ws1.ListObjects("TrainingRecords")
Set oRange = ws1.Columns(1)

x = 2
z = Me.Count.Value
Do Until x > z + 1
Set SearchName = ws2.Range("A" & x)

Set aCell = oRange.Find(What:=SearchName.Value, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
        If Not aCell Is Nothing Then
            Set bCell = aCell
            FoundAt = aCell.Address
            Do
            Set aCell = oRange.FindNext(After:=aCell)
            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                FoundAt = FoundAt & ", " & aCell.Address
            Else
                Exit Do
            End If
            Loop
        Else
            MsgBox SearchName.Value & " not Found"
            GoTo CloseCode
        End If
   MsgBox "The Search String has been found these locations: " & FoundAt
   x = x + 1
Loop
Exit Sub

CloseCode:
ws1.Unprotect Password:="started"
ws1.ListObjects("TrainingRecords").ShowAutoFilter = False
ws1.ListObjects("TrainingRecords").ShowAutoFilter = True

    With ws1
        .Cells(lRow, 3).Value = Me.TrainingCategoryInput.Value
        .Cells(lRow, 4).Value = Me.SubCategoryInput1.Value
        .Cells(lRow, 5).Value = Me.SubCategoryInput2.Value
        .Cells(lRow, 6).Value = Me.SubCategoryInput3.Value
        .Cells(lRow, 7).Value = Me.TrainingLevelInput.Value
        .Cells(lRow, 8).Value = Me.InstructorInput.Value
        .Cells(lRow, 9).Value = Me.LocationSelection.Value
        .Cells(lRow, 10).Value = Me.DateInputStart.Value
        .Cells(lRow, 11).Value = Me.DateInputEnd.Value
        .Cells(lRow, 12).Value = Me.HourInput.Value
        .Cells(lRow, 13).Value = Me.MinuteInput.Value
        .Cells(lRow, 15).Value = Me.DescriptionInput.Value
        .Cells(lRow, 16).Value = Me.Training.Value
        .Cells(lRow, 17).Value = "N"
    End With
ws2.ListObjects("TempName").DataBodyRange.Copy
ws1.Cells(lRow, 1).PasteSpecial xlPasteValues
ws2.ListObjects("TempName").DataBodyRange.Delete
For q = 3 To 13
    For Each Cell In tbl.ListColumns(q).Range
        If Cell.Value = "" Then
            Cell.FillDown
        End If
    Next
Next q
For q = 15 To 17
    For Each Cell In tbl.ListColumns(q).Range
        If Cell.Value = "" Then
            Cell.FillDown
        End If
    Next
Next q
tbl.ListColumns(18).DataBodyRange.Value = "=INDEX(EmployeeNames,MATCH([Employee Name], EmployeeNames[Name],0),5)"
ws1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="started"
Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox "Your training data has been recorded."
Unload Me
End Sub

 

[TheSecretaryJen]

I got it. Took me all afternoon, but it was worth it! I discovered that VBA refuses to match the value in the textboxes on my userform with the corresponding values in the table unless there are no spaces. There's probably a way around this, but I didn't want to be bothered, so I just subbed out all the spaces with underscores. Here's the final working code:

Sub EnterRecords()

'replaces the spaces in the textbox I want to match with underscores
Me.Training.Value = Replace(Me.Training.Value, " ", "_")Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Cell As Range
Dim q As Integer
Dim lRow As Long
Dim tbl As ListObject
Dim oRange As Range
Dim aCell As Range
Dim bCell As Range
Dim SearchName As String
Dim x As Integer
Dim z As Integer

Application.ScreenUpdating = False
Application.EnableEvents = False

Set ws1 = ActiveWorkbook.Worksheets("Training Records")
Set ws2 = ActiveWorkbook.Worksheets("Temp Name List")
lRow = ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Set tbl = ws1.ListObjects("TrainingRecords")
Set oRange = ws1.Columns(1)

ws1.Unprotect Password:="password"

'confirms that none of the table data is filtered out
ws1.ListObjects("TrainingRecords").ShowAutoFilter = False
ws1.ListObjects("TrainingRecords").ShowAutoFilter = True

'the number in this textbox is how many names were selected on the userform
z = Me.Count.Value

'the beginning row number of the data body range of my temporary name table
x = 2

'this tells the code to start the search at row 2 and end it when it reaches the last name on the table list
Do Until x > z + 1
'Sets the first name on the list as the string value to search for
SearchName = ws2.Range("A" & x).Value
Set aCell = oRange.Find(What:=SearchName, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
'If it finds that name, then compare adjacent cells to the textbox values
        If Not aCell Is Nothing Then
            If Me.DateInputStart.Text = Range("J" & aCell.Row).Text And _
            Me.DateInputEnd.Text = Range("K" & aCell.Row).Text And _
            Me.Training.Value = Range("P" & aCell.Row).Value Then
                'pops up a warning if there is a duplicate found, then exits the sub before recording the data
                MsgBox "WARNING! DUPLICATE ENTRY!" & vbNewLine & _
                "You have attempted to enter a duplicate record for " & SearchName & "." _
                & vbNewLine & "Please remove this name before continuing.", vbCritical
                Application.ScreenUpdating = True
                Application.EnableEvents = True
                Me.MultiPage1.Value = 1
                Exit Sub
            End If
           'if the first name found wasn't a duplicate, search for the rest of the occurences of that name
            Set bCell = aCell
            Do
                Set aCell = oRange.FindNext(After:=aCell)
                'If it finds no other occurrences except the first one, then exit the loop and move on
                If aCell Is Nothing Or aCell.Address = bCell.Address Then
                    Exit Do
                'if it finds another instance of that name, run it through the same checks
                Else:
                    If Me.DateInputStart.Text = Range("J" & aCell.Row).Text And _
                    Me.DateInputEnd.Text = Range("K" & aCell.Row).Text And _
                    Me.Training.Value = Range("P" & aCell.Row).Value Then
                        MsgBox "WARNING! DUPLICATE ENTRY!" & vbNewLine & _
                        "You have attempted to enter a duplicate record for " & SearchName & "." _
                        & vbNewLine & "Please remove this name before continuing.", vbCritical
                        Application.ScreenUpdating = True
                        Application.EnableEvents = True
                        Me.MultiPage1.Value = 1
                        Exit Sub
                    End If
                End If
            Loop
        End If
x = x + 1
'loops back and checks the next name on the list, until there are no more names left to check
Loop

'All of that just checked for duplicates. Now it copies the data from the userform and inserts it in the table on one row

    With ws1
        .Cells(lRow, 3).Value = Me.TrainingCategoryInput.Value
        .Cells(lRow, 4).Value = Me.SubCategoryInput1.Value
        .Cells(lRow, 5).Value = Me.SubCategoryInput2.Value
        .Cells(lRow, 6).Value = Me.SubCategoryInput3.Value
        .Cells(lRow, 7).Value = Me.TrainingLevelInput.Value
        .Cells(lRow, 8).Value = Me.InstructorInput.Value
        .Cells(lRow, 9).Value = Me.LocationSelection.Value
        .Cells(lRow, 10).Value = Me.DateInputStart.Value
        .Cells(lRow, 11).Value = Me.DateInputEnd.Value
        .Cells(lRow, 12).Value = Me.HourInput.Value
        .Cells(lRow, 13).Value = Me.MinuteInput.Value
        .Cells(lRow, 15).Value = Me.DescriptionInput.Value
        .Cells(lRow, 16).Value = Me.Training.Value
        .Cells(lRow, 17).Value = "N"
    End With
'now it copies all the names from the temporary list and puts them into the table in the appropriate column
ws2.ListObjects("TempName").DataBodyRange.Copy
ws1.Cells(lRow, 1).PasteSpecial xlPasteValues
ws2.ListObjects("TempName").DataBodyRange.Delete
'and then it fills all the other columns down to correspond with all the names
For q = 3 To 13
    For Each Cell In tbl.ListColumns(q).Range
        If Cell.Value = "" Then
            Cell.FillDown
        End If
    Next
Next q
For q = 15 To 17
    For Each Cell In tbl.ListColumns(q).Range
        If Cell.Value = "" Then
            Cell.FillDown
        End If
    Next
Next q
ws1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="started"
Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox "Your training data has been recorded."
Unload Me
End Sub

Hope this helps someone else struggling with the same problem!