Excel Rookie
New member
- Joined
- Mar 25, 2019
- Messages
- 11
- Reaction score
- 0
- Points
- 0
- Excel Version(s)
- 2013
Hi,
I presently have coding that allow a person to complete a UserForm and the data is moved to a sheet. Individuals may submit submit numerous request via The UserForm throughout the year in order to update their info so I need a macro to search the sheet for duplicate PRI's, remove that info and replace with the new information.
this is my present coding:
I presently have coding that allow a person to complete a UserForm and the data is moved to a sheet. Individuals may submit submit numerous request via The UserForm throughout the year in order to update their info so I need a macro to search the sheet for duplicate PRI's, remove that info and replace with the new information.
this is my present coding:
Code:
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
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'searching for duplicates
Set r = ws.Range("C:C").Find(Me.TxtPRI.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not r Is Nothing Then
MsgBox "You already have a record in the National Transfer Inventory. The previous record will be deleted and the new data entered in its place"
.EntireRow.Delete
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
'get province and city values
p = Me.Controls("ListProv" & n).Value
c = Me.Controls("ListCity" & n).Value
If n = 1 Or p <> "" Then '<<if on first loop, or province has been selected
rw.Cells(1).Resize(1, 10).Value = info '<< populate all common 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
Last edited by a moderator: