Find duplicate and append
 

Tom

Thanks for the code but I am not sure where I should be placing it and if I
need to adapt it to my code. I tried placing it ,as is, to the bottom of my
existing code but there seemed to be no effect as it just adds a new row of
data into my spreadsheet with the same Company name.

I am trying to create a spreadsheet (used as a simple database) to store
some comapny details of potential customers. So when I enter the data using
my Userform, it enters the data into the spreadsheet on a new row. I want
this userform to be able to search my spreadsheet first for any existing
companies, and if found to append the comments field to the existing
comments. If no existing compnay is found then a new row with my entered data
from the userform is then created. (I hope this all makes sense)

I have again, included my code below in the hope that this might clarify
what my form is doing. I understand there may be better ways of performing
this, but I am new to VBA and so my knowledge is very limited.

Thanks.

My code is:

Option Explicit
Dim iRow As Long
Dim ws As Worksheet


'add data to speadsheet and print form
Private Sub cmdCreatePrint_Click()
Set ws = Worksheets("Prospects")

'find first empty row in database
iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

'check for a company name
If Trim(Me.txtCompany.Value) = "" Then
Me.txtCompany.SetFocus
MsgBox "Please enter details for a new company"
Exit Sub
End If

'copy data to the database
ws.Cells(iRow, 1).Value = Me.txtCompany.Value
ws.Cells(iRow, 2).Value = Me.txtTitle.Value
ws.Cells(iRow, 3).Value = Me.txtFirstName.Value
ws.Cells(iRow, 4).Value = Me.txtSurname.Value
ws.Cells(iRow, 5).Value = Me.txtAddress1.Value
ws.Cells(iRow, 6).Value = Me.txtAddress2.Value
ws.Cells(iRow, 7).Value = Me.txtTown.Value
ws.Cells(iRow, 8).Value = Me.txtCounty.Value
ws.Cells(iRow, 9).Value = Me.txtPostcode.Value
ws.Cells(iRow, 10).Value = Me.txtCountry.Value
ws.Cells(iRow, 11).Value = Me.txtPhone.Value
ws.Cells(iRow, 12).Value = Me.txtFax.Value
ws.Cells(iRow, 13).Value = Me.txtEmail.Value
ws.Cells(iRow, 14).Value = Me.txtWeb.Value
ws.Cells(iRow, 15).Value = Me.txtDate.Value
ws.Cells(iRow, 16).Value = Me.txtComments.Value

'print completed form
Me.PrintForm

'clear form
Me.txtCompany.Value = ""
Me.txtTitle.Value = ""
Me.txtFirstName.Value = ""
Me.txtLastName.Value = ""
Me.txtAddress1.Value = ""
Me.txtAddress2.Value = ""
Me.txtTown.Value = ""
Me.txtCounty.Value = ""
Me.txtPostcode.Value = ""
Me.txtCountry.Value = ""
Me.txtPhone.Value = ""
Me.txtFax.Value = ""
Me.txtEmail.Value = ""
Me.txtWeb.Value = ""
Me.txtDate.Value = ""
Me.txtComments.Value = ""
Me.txtCompany.SetFocus

End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub


Private Sub txtComments_Change()

End Sub

'initialise and clear form
Private Sub UserForm_Initialize()
Me.txtCompany.Value = ""
Me.txtTitle.Value = ""
Me.txtFirstName.Value = ""
Me.txtLastName.Value = ""
Me.txtAddress1.Value = ""
Me.txtAddress2.Value = ""
Me.txtTown.Value = ""
Me.txtCounty.Value = ""
Me.txtPostcode.Value = ""
Me.txtCountry.Value = ""
Me.txtPhone.Value = ""
Me.txtFax.Value = ""
Me.txtEmail.Value = ""
Me.txtWeb.Value = ""
Me.txtDate.Value = ""
Me.txtComments.Value = ""
Me.txtCompany.SetFocus

End Sub

'Add form data to Excel spreadsheet
Private Sub cmdCreate_Click()
Set ws = Worksheets("Prospects")

'find first empty row in database
iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

'check for a company name
If Trim(Me.txtCompany.Value) = "" Then
Me.txtCompany.SetFocus
MsgBox "Please enter details for a new company"
Exit Sub
End If

'copy data to the database
ws.Cells(iRow, 1).Value = Me.txtCompany.Value
ws.Cells(iRow, 2).Value = Me.txtTitle.Value
ws.Cells(iRow, 3).Value = Me.txtFirstName.Value
ws.Cells(iRow, 4).Value = Me.txtLastName.Value
ws.Cells(iRow, 5).Value = Me.txtAddress1.Value
ws.Cells(iRow, 6).Value = Me.txtAddress2.Value
ws.Cells(iRow, 7).Value = Me.txtTown.Value
ws.Cells(iRow, 8).Value = Me.txtCounty.Value
ws.Cells(iRow, 9).Value = Me.txtPostcode.Value
ws.Cells(iRow, 10).Value = Me.txtCountry.Value
ws.Cells(iRow, 11).Value = Me.txtPhone.Value
ws.Cells(iRow, 12).Value = Me.txtFax.Value
ws.Cells(iRow, 13).Value = Me.txtEmail.Value
ws.Cells(iRow, 14).Value = Me.txtWeb.Value
ws.Cells(iRow, 15).Value = Me.txtDate.Value
ws.Cells(iRow, 16).Value = Me.txtComments.Value

'clear form
Me.txtCompany.Value = ""
Me.txtTitle.Value = ""
Me.txtFirstName.Value = ""
Me.txtLastName.Value = ""
Me.txtAddress1.Value = ""
Me.txtAddress2.Value = ""
Me.txtTown.Value = ""
Me.txtCounty.Value = ""
Me.txtPostcode.Value = ""
Me.txtCountry.Value = ""
Me.txtPhone.Value = ""
Me.txtFax.Value = ""
Me.txtEmail.Value = ""
Me.txtWeb.Value = ""
Me.txtDate.Value = ""
Me.txtComments.Value = ""
Me.txtCompany.SetFocus

End Sub