UserForm in excel - searching for duplicates

Blanchetdb

Board Regular
Joined
Jul 31, 2018
Messages
63
Hi,

I require help as I have a tried a number of options found in the forum but none seem to work...

This is what I need to happen - the person completes the User Form. Once they submit, I require a search to happen to see if it is a duplicate entry (First name, Last name and user ID already exist) and If so, it deletes the previous lines and replaces with the new information.

this is my present coding:

Code:
Private Sub CmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Const strPwd As String = "Transfer19"


ThisWorkbook.Unprotect Password:=strPwd
Set ws = Worksheets("Inventory") 


iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

If Trim(Me.TxtFirst.Value) = "" Then
  Me.TxtFirst.SetFocus
  MsgBox "Please complete First Name field"
  Exit Sub
End If

If Trim(Me.TxtLast.Value) = "" Then
  Me.TxtFirst.SetFocus
  MsgBox "Please complete Last Name field"
  Exit Sub
End If
If Trim(Me.TxtPRI.Value) = "" Then
  Me.TxtFirst.SetFocus
  MsgBox "Please complete the PRI field"
  Exit Sub
End If
If Trim(Me.TxtLinguistic.Value) = "" Then
  Me.TxtFirst.SetFocus
  MsgBox "Please select a linguistic choice"
  Exit Sub
End If
If Trim(Me.TxtEmail.Value) = "" Then
  Me.TxtFirst.SetFocus
  MsgBox "Please insert your Email address"
  Exit Sub
End If
If Trim(Me.ListProv1.Value) = "" Then
  Me.TxtFirst.SetFocus
  MsgBox "Please select a Province"
  Exit Sub
End If
If Trim(Me.ListCity1.Value) = "" Then
  Me.TxtFirst.SetFocus
  MsgBox "Please select a City"
  Exit Sub
End If
If Trim(Me.TxtResumeNum.Value) = "" Then
  Me.TxtFirst.SetFocus
  MsgBox "Please provide us with the RDIMS# to your resume"
  Exit Sub
End If
If Trim(Me.TxtDate.Value) = "" Then
  Me.TxtFirst.SetFocus
  MsgBox "Please insert your registration date"
  Exit Sub
End If
If Trim(Me.TxtGRLV.Value) = "" Then
  Me.TxtFirst.SetFocus
  MsgBox "Please insert Substantive Group & Level"

  Exit Sub
End If
 

 With ws
  .Unprotect Password:="Transfer19"
  .Cells(iRow, 1).Value = Me.TxtFirst.Value
  .Cells(iRow, 2).Value = Me.TxtLast.Value
  .Cells(iRow, 3).Value = Me.TxtPRI.Value
  .Cells(iRow, 4).Value = Me.TxtGRLV.Value
  .Cells(iRow, 5).Value = Me.TxtLinguistic.Value
  .Cells(iRow, 6).Value = Me.TxtEmail.Value
  .Cells(iRow, 7).Value = Me.TxtResumeNum.Value
  .Cells(iRow, 8).Value = Me.TxtReason.Value
  .Cells(iRow, 9).Value = Me.TxtDate.Value
  .Cells(iRow, 10).Value = Me.ListProv1.Value
  .Cells(iRow, 11).Value = Me.ListCity1.Value
  .Cells(iRow + 1, 10).Value = Me.ListProv2.Value
  .Cells(iRow + 1, 11).Value = Me.ListCity2.Value
  .Cells(iRow + 2, 10).Value = Me.ListProv3.Value
  .Cells(iRow + 2, 11).Value = Me.ListCity3.Value
  .Cells(iRow + 3, 10).Value = Me.ListProv4.Value
  .Cells(iRow + 3, 11).Value = Me.ListCity4.Value
  .Cells(iRow + 4, 10).Value = Me.ListProv5.Value
  .Cells(iRow + 4, 11).Value = Me.ListCity5.Value
  .Cells(iRow + 5, 10).Value = Me.ListProv6.Value
  .Cells(iRow + 5, 11).Value = Me.ListCity6.Value
  .Cells(iRow + 6, 10).Value = Me.ListProv7.Value
  .Cells(iRow + 6, 11).Value = Me.ListCity7.Value
  .Cells(iRow + 7, 10).Value = Me.ListProv8.Value
  .Cells(iRow + 7, 11).Value = Me.ListCity8.Value
  .Cells(iRow + 8, 10).Value = Me.ListProv9.Value
  .Cells(iRow + 8, 11).Value = Me.ListCity9.Value
  .Cells(iRow + 9, 10).Value = Me.ListProv10.Value
  .Cells(iRow + 9, 11).Value = Me.ListCity10.Value
  .Protect Password:="Transfer19"
  
 End With



ThisWorkbook.Protect Password:=strPwd
ThisWorkbook.Save


End Sub
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
10,194
Office Version
2007
Platform
Windows
Try the following

Code:
Private Sub CmdAdd_Click()
    Dim iRow As Long
    Dim ws As Worksheet
[COLOR=#0000ff]    Dim r As Range[/COLOR]
    Const strPwd As String = "Transfer19"
    
    
    ThisWorkbook.Unprotect Password:=strPwd
    Set ws = Worksheets("Inventory")
    
    
    'iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
    iRow = ws.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
    
    If Trim(Me.TxtFirst.Value) = "" Then
      Me.TxtFirst.SetFocus
      MsgBox "Please complete First Name field"
      Exit Sub
    End If
    If Trim(Me.TxtLast.Value) = "" Then
      Me.TxtFirst.SetFocus
      MsgBox "Please complete Last Name field"
      Exit Sub
    End If
    If Trim(Me.TxtPRI.Value) = "" Then
      Me.TxtFirst.SetFocus
      MsgBox "Please complete the PRI field"
      Exit Sub
    End If
    '
    If Trim(Me.TxtLinguistic.Value) = "" Then
      Me.TxtFirst.SetFocus
      MsgBox "Please select a linguistic choice"
      Exit Sub
    End If
    If Trim(Me.TxtEmail.Value) = "" Then
      Me.TxtFirst.SetFocus
      MsgBox "Please insert your Email address"
      Exit Sub
    End If
    If Trim(Me.ListProv1.Value) = "" Then
      Me.TxtFirst.SetFocus
      MsgBox "Please select a Province"
      Exit Sub
    End If
    If Trim(Me.ListCity1.Value) = "" Then
      Me.TxtFirst.SetFocus
      MsgBox "Please select a City"
      Exit Sub
    End If
    If Trim(Me.TxtResumeNum.Value) = "" Then
      Me.TxtFirst.SetFocus
      MsgBox "Please provide us with the RDIMS# to your resume"
      Exit Sub
    End If
    If Trim(Me.TxtDate.Value) = "" Then
      Me.TxtFirst.SetFocus
      MsgBox "Please insert your registration date"
      Exit Sub
    End If
    If Trim(Me.TxtGRLV.Value) = "" Then
      Me.TxtFirst.SetFocus
      MsgBox "Please insert Substantive Group & Level"


      Exit Sub
    End If
'
    
[COLOR=#0000ff]    'searching for duplicates[/COLOR]
[COLOR=#0000ff]    Set r = ws.Range("C:C").Find(Me.TxtPRI.Value, LookIn:=xlValues, lookat:=xlWhole)[/COLOR]
[COLOR=#0000ff]    If Not r Is Nothing Then[/COLOR]
[COLOR=#0000ff]        MsgBox "Duplicate entry. The record is deleted and the new data is placed"[/COLOR]
[COLOR=#0000ff]        iRow = r.Row[/COLOR]
[COLOR=#0000ff]    End If[/COLOR]
    
    With ws
        .Unprotect Password:="Transfer19"
        .Cells(iRow, 1).Value = Me.TxtFirst.Value
        .Cells(iRow, 2).Value = Me.TxtLast.Value
        .Cells(iRow, 3).Value = Me.TxtPRI.Value
        .Cells(iRow, 4).Value = Me.TxtGRLV.Value
        .Cells(iRow, 5).Value = Me.TxtLinguistic.Value
        .Cells(iRow, 6).Value = Me.TxtEmail.Value
        .Cells(iRow, 7).Value = Me.TxtResumeNum.Value
        .Cells(iRow, 8).Value = Me.TxtReason.Value
        .Cells(iRow, 9).Value = Me.TxtDate.Value
        .Cells(iRow, 10).Value = Me.ListProv1.Value
        .Cells(iRow, 11).Value = Me.ListCity1.Value
        .Cells(iRow + 1, 10).Value = Me.ListProv2.Value
        .Cells(iRow + 1, 11).Value = Me.ListCity2.Value
        .Cells(iRow + 2, 10).Value = Me.ListProv3.Value
        .Cells(iRow + 2, 11).Value = Me.ListCity3.Value
        .Cells(iRow + 3, 10).Value = Me.ListProv4.Value
        .Cells(iRow + 3, 11).Value = Me.ListCity4.Value
        .Cells(iRow + 4, 10).Value = Me.ListProv5.Value
        .Cells(iRow + 4, 11).Value = Me.ListCity5.Value
        .Cells(iRow + 5, 10).Value = Me.ListProv6.Value
        .Cells(iRow + 5, 11).Value = Me.ListCity6.Value
        .Cells(iRow + 6, 10).Value = Me.ListProv7.Value
        .Cells(iRow + 6, 11).Value = Me.ListCity7.Value
        .Cells(iRow + 7, 10).Value = Me.ListProv8.Value
        .Cells(iRow + 7, 11).Value = Me.ListCity8.Value
        .Cells(iRow + 8, 10).Value = Me.ListProv9.Value
        .Cells(iRow + 8, 11).Value = Me.ListCity9.Value
        .Cells(iRow + 9, 10).Value = Me.ListProv10.Value
        .Cells(iRow + 9, 11).Value = Me.ListCity10.Value
        .Protect Password:="Transfer19"
    
    End With
    
    
    
    ThisWorkbook.Protect Password:=strPwd
    ThisWorkbook.Save




End Sub
 

Forum statistics

Threads
1,089,485
Messages
5,408,546
Members
403,214
Latest member
Kurtrkelly

This Week's Hot Topics

  • help please
    SORRY NOT ANY GOOD AT EXCEL SO HELP WOULD BE MUCH APPRECIATED this formula is in a sheet called ignore...
  • two formulas needed
    Hello, I'll try my best to explain this: First formula needed in Sheet1 cell A2: If Sheet1 cell B2 = Sheet2 cell B2 then return a 1. If not then...
  • Dynamic Counts
    Good afternoon, we are tidying up some data & the data seems to be growing quicker than we are tidying it up! What we confirm (by reviewing it...
  • Help Excel formula eliminate duplicate values and keep only 2 identical rows.
    as picture below column A has a duplicate value. but the values are not the same as the rule. sometimes 4 rows, sometimes 10 rows or 7 or 9...
  • Macro Compile Error Sub or Function not defined
    Hello, I am trying to run macros from a validation list, all macros have been created and run perfectly on there own but I'm getting a compile...
  • Last row combined with Current Region VBA
    I'm generally happy finding the last row of data through something like Lastrow = Cells(Rows.Count, "D").End(xlUp) but I don't always receive data...
Top