Deleting duplicate rows and adding new information

[Blanchetdb]

Hi,

I need a macro that will take information from a UserForm, search a sheet for duplicate entry (PRI number). If duplicate rows are found, they are deleted and the new information from the UserForm inserted onto the sheet.

this is my present coding

Private Sub CmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Dim r As Range
Dim info, rw As Range, n As Long


Const strPwd As String = "Transfer19"
ThisWorkbook.Unprotect Password:=strPwd


Set ws = Worksheets("Inventory")
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.TxtGR.Value) = "" Then
Me.TxtFirst.SetFocus
MsgBox "Please insert Substantive Group"
Exit Sub
End If
If Trim(Me.TxtLV.Value) = "" Then
Me.TxtFirst.SetFocus
MsgBox "Please insert Substantive Level"
Exit Sub
End If



With ws
'get all the tombstone info into an array
info = Array(Me.TxtFirst.Value, Me.TxtLast.Value, _
Me.TxtPRI.Value, Me.TxtGR.Value, _
Me.TxtLV.Value, Me.TxtLinguistic.Value, _
Me.TxtEmail.Value, Me.TxtResumeNum.Value, _
Me.TxtReason.Value, Me.TxtDate.Value)

.Unprotect Password:="Transfer19"


'get the first empty row...
Set rw = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow


'loop over the province and city controls
For n = 1 To 10
p = Me.Controls("ListProv" & n).Value
c = Me.Controls("ListCity" & n).Value

If n = 1 Or p <> "" Then
rw.Cells(1).Resize(1, 10).Value = info
rw.Cells(11).Value = p
rw.Cells(12).Value = c
Set rw = rw.Offset(1, 0) 'move down one row
End If
Next n


.Protect Password:="Transfer19"

End With


ThisWorkbook.Protect Password:=strPwd
ThisWorkbook.Save


End Sub

 

[Fluff]

Duplicate https://www.mrexcel.com/forum/excel...-new-information-post5245963.html#post5245963

Please do not post the same question multiple times. All clarifications, follow-ups, and bumps should be posted back to the original thread.
Per forum rules, posts of a duplicate nature will be locked or deleted (rule 12 here: Forum Rules).

If you do not receive a response, you can "bump" it by replying to it again, though we advise you to wait 24 hours before doing and not to bump a thread more than once a day.