UserForm in excel - searching for duplicates

B

Blanchetdb

Board Regular
Joined
Jul 31, 2018
Messages
153
Office Version
  1. 2016
Platform
  1. Windows
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:

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Sort by date Sort by votes
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
Add in VBA Code to check zip code against pre-determined list
Replies
0
Views
156
mikefisher
M
K
  • Solved
VBA not finding next empty row due to formula
Replies
8
Views
914
Alex Blakenburg
A
K
  • Question
Modifying Existing VBA Code to add 2 additional data columns
Replies
0
Views
140
keranali
K
M
  • Solved
Excel Userform: certain fields need to be entered
Replies
6
Views
471
Micron
M
J
  • Question
VBA Code Help - Search Form
Replies
1
Views
876
James006
James006

Forum statistics

Threads
1,214,978
Messages
6,122,545
Members
449,089
Latest member
davidcom

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top