Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Find and append | Excel Discussion (Misc queries) | |||
FIND DUPLICATE | Excel Discussion (Misc queries) | |||
Find Duplicates and Append | Excel Programming | |||
Find duplicates and append | Excel Worksheet Functions | |||
find and delete duplicate entries in two columns or find and prin. | Excel Programming |