Deleting duplicate rows and adding new information

Status
Not open for further replies.

Blanchetdb

Board Regular
Joined
Jul 31, 2018
Messages
74
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
 

Some videos you may like

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.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,530
Office Version
  1. 365
Platform
  1. Windows
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.

 
Status
Not open for further replies.

Watch MrExcel Video

Forum statistics

Threads
1,109,331
Messages
5,528,056
Members
409,799
Latest member
camronmartin

This Week's Hot Topics

Top