UserForm in excel - searching for duplicates

B

Blanchetdb

Board Regular
Joined
Jul 31, 2018
Messages
164
Office Version
  1. 365
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

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
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

E
  • Question Question
Generate unique code based on user form entry and put in table
2
Replies
18
Views
503
Micron
M
M
  • Question Question
Add in VBA Code to check zip code against pre-determined list
Replies
0
Views
417
mikefisher
M
R
  • Question Question
VBA Code Works in Visual Basic Coder, but not with Command Button in Excel
Replies
3
Views
262
rheintz
R
K
  • Question Question
I was try to load data To List Box And Transfer data to Sheet2.... (Not work this userform)
Replies
4
Views
237
krunal123
K
D
  • Question Question
Can't get folder to create on desktop. When debugging it shows no errors.
2 3
Replies
24
Views
435
jolivanes
jolivanes

Forum statistics

Threads
1,224,820
Messages
6,181,157
Members
453,021
Latest member
Justyna P

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