Help with my excel and vba

[ellin00ra]

I have managed to do (read:copy-paste) a bit of a code by myself, but now can't figure out couple of mistakes. First of all this makro that does the searching, searches also the temp file in that workbook, so there are duplicate rows in the end...

And then it shoud search whole sheets instead pieces of them...

I'll copy the code here, if someone could help me out..

Thanks
-e-

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim hakemisto As String, tied As String
Dim rivi As Integer

rivi = ActiveCell.Row

valittu = ActiveCell.Address
Range("A" & rivi).Select


'Jos muu sarake A on tyhjä - lopetetaan
If Range("A" & rivi) = "" Then Exit Sub


' *** ASETUKSET *****
hakemisto = "C:\"
tied = "kauppaloki.doc"

'********************



' MUUTTUJAT
yhtio = Range("A" & rivi)
etunimi = Range("Z" & rivi)
osoite = Range("AD" & rivi)
postinro = Range("AF" & rivi)
osakemaara = Range("AO" & rivi)

'EPÄSELVÄT
tilinro = Range("AX" & rivi)
kplhinta = Range("AY" & rivi)
verotuskunta = Range("AZ" & rivi)
puhnro = Range("BA" & rivi)
syntaika = Range("BB" & rivi)

Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True

Set wrdDoc = WordApp.Documents.Open(Filename:=hakemisto & tied)

wrdDoc.FormFields("yhtiö").Result = yhtio
wrdDoc.FormFields("etunimi").Result = etunimi
wrdDoc.FormFields("katuosoite").Result = osoite
wrdDoc.FormFields("Postiosoite").Result = postinro
wrdDoc.FormFields("Osakemäärä").Result = osakemaara

wrdDoc.FormFields("Tilinumero").Result = tilinro
wrdDoc.FormFields("Kauppahinta").Result = kplhinta * osakemaara
wrdDoc.FormFields("Kotikunta").Result = verotuskunta
wrdDoc.FormFields("Puhelinnumero").Result = puhnro
wrdDoc.FormFields("Syntymäaika").Result = syntaika

Dim oField As Field
Dim oStory As Range

For Each oField In wrdDoc.Fields
If oField.Type = wdFieldRef Then
oField.Update
End If
Next oField

'wrdDoc.Close savechanges:=True
'Set wrdDoc = Nothing
'WordApp.Quit
'Set WordApp = Nothing

End Sub

Dim oStory As Range

For Each oField In wrdDoc.Fields
If oField.Type = wdFieldRef Then
oField.Update
End If
Next oField

wrdDoc.Close savechanges:=True
Set wrdDoc = Nothing
WordApp.Quit
Set WordApp = Nothing

End Sub

Sub SearchandCopy()

Dim oSheet As Object
Dim Firstcell As Range
Dim NextCell As Range
Dim WhatToFind As Variant
Dim rCopyCells As Range

On Error GoTo Err

Application.ScreenUpdating = False
Sheets("Temp").Select
Range("A2:D1000").Select
Selection.ClearContents
Sheets("Vero").Select
Application.ScreenUpdating = True

WhatToFind = Application.InputBox("Kirjoita nimi?", "Etsi", , 100, 100, , , 2)

If WhatToFind = False Then
Sheets("Vero").Select
End
End If

If WhatToFind <> "" And Not WhatToFind = False Then
For Each oSheet In ActiveWorkbook.Worksheets
oSheet.Activate
oSheet.[a1].Activate
Set Firstcell = Cells.Find(What:=WhatToFind, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not Firstcell Is Nothing Then
Firstcell.Activate
If MsgBox("Add Record", vbInformation + vbYesNo) = vbYes Then
ActiveCell.Select
Selection.EntireRow.Copy Destination:= _
Sheets("Temp").Range("A65536").End(xlUp).Offset(1, 0)

Set rCopyCells = Nothing
End If

On Error Resume Next
While (Not NextCell Is Nothing) And (Not NextCell.Address = Firstcell.Address)
Set NextCell = Cells.FindNext(After:=ActiveCell)
If Not NextCell.Address = Firstcell.Address Then
NextCell.Activate
If MsgBox("Add Record", vbInformation + vbYesNo) = vbYes Then
ActiveCell.Select
Selection.EntireRow.Copy Destination:= _
Sheets("Temp").Range("A65536").End(xlUp).Offset(1, 0)

End If
End If
Wend
End If
Set NextCell = Nothing
Set Firstcell = Nothing
Next oSheet
End If

Application.ScreenUpdating = False
Sheets("Temp").Select
Range("A2,AA1300").Select
Application.ScreenUpdating = True
Sheets("Vero").Select
Sheets("Temp").Copy
End
Err:
MsgBox "Sorry, virhe. Yritä uudelleen!"
End
End Sub