Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Find and append Susan Excel Discussion (Misc queries) 0 April 25th 07 08:08 PM
FIND DUPLICATE shaji Excel Discussion (Misc queries) 3 January 27th 07 03:51 PM
Find Duplicates and Append HUBBUB88[_2_] Excel Programming 2 November 9th 05 02:10 PM
Find duplicates and append HUBBUB88 Excel Worksheet Functions 0 October 10th 05 08:00 PM
find and delete duplicate entries in two columns or find and prin. campare 2 columns of numbers-find unique Excel Programming 1 November 24th 04 04:09 PM


All times are GMT +1. The time now is 05:22 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"