View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Greg Wilson Greg Wilson is offline
external usenet poster
 
Posts: 747
Default 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