Loop met zoekfunctie met 2 mogelijkheden

[loggy]

Hallo,

Ik probeer een loop te maken met een zoekfunctie waarbij wanneer de waarde niet gevonden wordt hij iets anders uitvoerd. Als de zoekwaarde gevonden wordt, hoeft alleen maar de datum aangepast worden. Als de zoekwaarde niet gevonden wordt, moet de gehele rij toegevoegd worden. Dit dient geloopt te worden tot alle rijen doorlopen zijn. Als de zoekwaarde gevonden wordt gaat het prima, het gaat fout op het moment dat de zoekwaarde niet gevonden wordt. Ik blijf de melding krijgen "fout 91 objectvariabele of blokvariabele with niet ingesteld". Naar wat gezoek op dit forum ben ik dan op de volgende code gekomen, maar hij blijft de melding maar geven:

Sub zoek__vul()
Windows("output33.htm").Activate
Start = Range("D1").Address
Range(Start).Select

Do
waarde = ActiveCell.Value
Start = ActiveCell.Offset(1, 0).Address
datum = ActiveCell.Offset(0, 3).Value
Range(ActiveCell.Offset(0, -3), ActiveCell.Offset(0, 5)).Select
Selection.Copy

Windows("Planningstool SIPS V1.0.xlsm").Activate

Dim C As Range
With Range("D110000")
Set C = .Find(waarde).Offset(0, 3)

If Not C Is Nothing Then
x = C.Select
ActiveCell.Value = datum
Else
Set C = .Find("").Offset(0, -3).Select
ActiveSheet.Paste
End If
End With
Windows("output33.htm").Activate
Range(Start).Select

If ActiveCell.Value = "" Then Exit Do
Loop

End Sub

Ik heb ook dit geprobeert, maar ook dat gaat niet.

Sub zoek__vul()
Windows("output33.htm").Activate
Start = Range("D1").Address
Range(Start).Select

Do
waarde = ActiveCell.Value
Start = ActiveCell.Offset(1, 0).Address
datum = ActiveCell.Offset(0, 5).Value
Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, 8)).Select
Selection.Copy


Windows("Planningstool SIPS V1.0.xlsm").Activate
On Error GoTo CatchError
Range("B1:B10000").Find(waarde).Offset(0, 5).Value = datum

CatchError:
Range("B1:B10000").Find("").Offset(0, -1).Select
ActiveSheet.Paste
GoTo NormalExit

NormalExit:
Windows("output33.htm").Activate
Range(Start).Select
If ActiveCell.Value = "" Then Exit Do
Loop
End Sub

Wie kan mij op weg helpen?

 

[loggy]

jammer dat ik hier niet zelf de oplossing heb gevonden. Echter een ochtend doorstoeien, heeft me zelf de oplossing doen vinden. Hieronder de oplossing:

Do
waarde = ActiveCell.Address
Start = ActiveCell.Offset(1, 0).Address
datum = ActiveCell.Offset(0, 3).Value
Range(ActiveCell.Offset(0, -3), ActiveCell.Offset(0, 5)).Select
Selection.Copy

Dim zoek As String
Dim FoundRange As Range

zoek = Range(waarde).Value

Windows("Planningstool SIPS V1.0.xlsm").Activate
Set FoundRange = Sheets("Primavera").Cells.Find(what:=zoek, LookIn:=xlFormulas, lookat:=xlWhole)

If FoundRange Is Nothing Then
Range("D110000").Find("").Offset(0, -3).Select
ActiveSheet.Paste

Else
Range("D110000").Find(zoek).Offset(0, 3).Value = datum
End If

Windows("output33.htm").Activate
Range(Start).Select
If ActiveCell.Value = "" Then Exit Do
Loop

End Sub