Look for the duplicate Records Before entering in database sheet

[yogeshwarv]

Hi Friends,

I have got a file which is basically an address book. Contact records moves to database sheet when entered in the data forum. I need to make this contact file more customized.

I wish when I enter value in First Name, Last Name and Phone No. and transfer the records to database it should check prompt if the these compulsory fields are filled up to avoid mistake else check and prompt if records entered already exist in database else transfer data in the database sheet.

Can anybody please help me in this?

I am enclosing herewith the file to make it understand better.

Regards
Yogeshwar

[lucas]

We can't see the sheets in your attachment.

[Aussiebear]

Here you go Steve

[lucas]

I could have unhidden them Ted. I was just trying to get the poster to understand that when you post you should give something that is easy to work with instead of a puzzle before you can even address the problem...

thanks though.

[georgiboy]

Sub Adder()
Dim rCell As Range
TEMPLATE_SHEET = "Form"
DATABASE_SHEET = "Database"
DATABASE_RECORDS = Sheets(DATABASE_SHEET).Range("A1:A10000")
'Find out if name or number are blank
For Each rCell In Sheets("Form").Range("B2:B4").Cells
    If rCell.Value = "" Then
        MsgBox "Please make sure all info is entered", vbInformation, "More info needed..."
        Exit Sub
    End If
Next rCell
'To find out if names or number exists
If WorksheetFunction.CountIf(Sheets("Database").Range("A:A"), Sheets("Form").Range("B2").Value) > 0 Then
    If WorksheetFunction.CountIf(Sheets("Database").Range("B:B"), Sheets("Form").Range("B3").Value) > 0 Then
        If WorksheetFunction.CountIf(Sheets("Database").Range("C:C"), Sheets("Form").Range("B4").Value) > 0 Then
            MsgBox "This entry already exists", vbInformation, "Duplicate"
            Range("B2:B6").ClearContents
            Exit Sub
        End If
    End If
End If
Application.ScreenUpdating = False
COUNT_ROW = WorksheetFunction.CountA(Sheets("Database").Range("A:A"))+1
'To copy the data from the template to the database
'Data Field 1 to database
Sheets(TEMPLATE_SHEET).Select
Sheets(DATABASE_SHEET).Range("A" & COUNT_ROW).Value = Range("B2").Value
Sheets(DATABASE_SHEET).Range("B" & COUNT_ROW).Value = Range("B3").Value
Sheets(DATABASE_SHEET).Range("C" & COUNT_ROW).Value = Range("B4").Value
Sheets(DATABASE_SHEET).Range("D" & COUNT_ROW).Value = Range("B5").Value
Sheets(DATABASE_SHEET).Range("E" & COUNT_ROW).Value = Range("B6").Value
Range("B2:B6").ClearContents
Application.ScreenUpdating = True
End Sub

Hope this helps

[yogeshwarv]

Hi,

I apologies with the borders who could not see the sheets in attachment
and would like to thank to lucas, Aussiebear to put their efforts to help me out and sincerely thank georgiboy to understand the problem and helped me because it really worked as I wanted. Thanx Georgiboy, you are the rockstar.

The attachment opens perfectly at my computer, I dont know what had happened.