I have set up a small excel sheet containing addresses.

Reading the data is no problem but I want to write one
particular value (last number used) back to the excel
sheet and it keeps creating copies of the original sheet.

Thanks for any tip solving the problem

Kind regards

Jan Groen
The Netherlands

used code below

Dim myObject As Object
Dim i As Integer
Dim myRec As Integer

Dim myName As String
Dim myAddress As String
Dim myCity As String
Dim myDate2 As String
Dim myNumber As Integer

Dim myRange As Range

Const myFile As String = "C:\Documents and
Settings\Petra\Mijn documenten\Administratie\adressen.xls"

Private Sub cmdCancel_Click()
   myObject.Quit
   Unload Me

End Sub

Private Sub cmdOk_Click()
   If lbxAdressen.ListIndex < 0 Then
       MsgBox "Selecteer eerst een naam, klik dan op Ok"
   
   Else
       myRec = lbxAdressen.ListIndex + 2
       myObject.activesheet.Range("b" & myRec).Select
       myName = myObject.activesheet.Range("b" &
myRec).Value
       Set myRange = ActiveDocument.Bookmarks
("Name").Range
       myRange.Text = myName
       ActiveDocument.Bookmarks.Add "Name", myRange
       
       Set myRange = ActiveDocument.Bookmarks
("Name2").Range
       myRange.Text = myName
       ActiveDocument.Bookmarks.Add "Name2", myRange
     
       myObject.activesheet.Range("c" & myRec).Select
       myAddress = myObject.activesheet.Range("c" &
myRec).Value
       Set myRange = ActiveDocument.Bookmarks
("Address").Range
       myRange.Text = myAddress
       ActiveDocument.Bookmarks.Add "Address", myRange

       myObject.activesheet.Range("d" & myRec).Select
       myCity = myObject.activesheet.Range("d" &
myRec).Value
       Set myRange = ActiveDocument.Bookmarks
("City").Range
       myRange.Text = myCity
       ActiveDocument.Bookmarks.Add "City", myRange
       
       myObject.activesheet.Range("e" & myRec).Select
       myDate2 = myObject.activesheet.Range("e" &
myRec).Value
       Set myRange = ActiveDocument.Bookmarks
("Date2").Range
       myRange.Text = myDate2
       ActiveDocument.Bookmarks.Add "Date2", myRange

       Set myRange = ActiveDocument.Bookmarks
("Date").Range
       myRange.Text = DTPicker1.Value
       ActiveDocument.Bookmarks.Add "Date", myRange
             
       Set myRange = ActiveDocument.Bookmarks
("Number").Range
       myRange.Text = txtNumber.Text
       ActiveDocument.Bookmarks.Add "Number", myRange
                                     
       myObject.worksheets("Nummering").Select
       myObject.activesheet.Range("a1").Select
       myObject.activecell.Value = myNumber
       
       myObject.Save
       myObject.Quit
               
       ActiveDocument.Protect Password:="",
NoReset:=False, Type:= _
       wdAllowOnlyFormFields
       
       Unload Me
               
   End If
End Sub

Private Sub UserForm_Initialize()

   i = 2
   Set myObject = CreateObject("Excel.application")
   myObject.workbooks.Open (myFile)

   myObject.worksheets("Nummering").Select
   myObject.activesheet.Range("a1").Select
   myNumber = (myObject.activecell.Value)
   myNumber = myNumber + 1
   
   txtNumber.Text = Right("000" & myNumber, 3)

   myObject.worksheets("adressen").Select
   myObject.activesheet.Range("a2").Select
   
   While Not myObject.activecell = ""
       lbxAdressen.AddItem (myObject.activecell.Value)
       i = i + 1
       myObject.activesheet.Range("a" & i).Select
   Wend
                                                 
   DTPicker1.Value = Date
   
End Sub