Preventing duplicates when adding records to list
The following is the suggested basic mechanics with most of your code ommitted:
Set ws = Sheets("Contact List")
'Establish range of all existing contact names
Set r = ws.Range(ws.Cells(2, 2), ws.Cells(Rows.Count, 2).End(xlUp))
namecl = ActiveSheet.Range("f105")
'Search for namec1 in existing list of contact names
If Not r.Find(namecl) Is Nothing Then
msg = "A client entry for " & namecl & " already exists. Cannot add
contact. "
MsgBox msg, vbCritical, "Add New Contact"
Else
'Your code here
End If
Suggested rewrite using a Type construct follows. I find a Type construct
useful for this sort of thing for readability. This is intended for
illustration purposes only and should be tested on a copy of your data. Some
adjustment is very likely required.
Type CInfo
Indx As Long
nm As String
Phone As String
Fax As String
Contact As String
GST As String
Email As String
InitDate As String
PostCode As String
End Type
Sub newcontact()
Dim CustomerInfo As CInfo
Dim c As Range, r As Range
Dim msg As String
Dim ws As Worksheet
Set ws = Sheets("Contact List")
Set r = ws.Range(ws.Cells(2, 2), ws.Cells(Rows.Count, 2).End(xlUp))
With CustomerInfo
.Indx = Val(Range("B134")) + 1
.nm = Range("F105")
.Fax = Range("F106")
.Contact = Range("F108")
.GST = Range("F109")
.Phone = Range("C106")
.Email = Range("C107")
.InitDate = Range("C108")
.PostCode = Range("C109")
If Not r.Find(.nm) Is Nothing Then
msg = "A client entry for " & .nm & " already exists. Cannot add
contact. "
MsgBox msg, vbCritical, "Add New Contact"
Else
Set c = r(r.Count + 1)
Application.ScreenUpdating = False
c(1, 0) = .Indx
c(1, 1) = .nm
c(1, 2) = .Phone
c(1, 3) = .Fax
c(1, 4) = .Email
c(1, 5) = .InitDate
c(1, 6) = .Contact
c(1, 7) = .PostCode
c(1, 8) = .GST
Application.ScreenUpdating = True
End If
End With
End Sub
Regards,
Greg
|