FindNext probleem

[Symphysodon]

Beste forummers,

Ik heb een FindNext probleem waar ik niet uit kom.

Het idee van het programma is een verzameltabel te bouwen vanuit gegevens van een 'inputbestand'. Het zoeken en kopieren van de gegevens bestaat uit een match tussen een element en een standaard. Het aantal gelijke standaarden (kolom 9) kan meer zijn dan 1. Om dat op te lossen heb ik FindNext gebruikt. Dit lukt helaas niet vanwege error code 424, alleen de eerst gevonden match wordt gekopieerd.

Sub tabelvuller()
Dim inputWs As Worksheet
Dim outputWB As Workbook
Dim lR As Long
Dim lK As Long
Dim listTBL As ListObject
Dim i As Long, j As Long, k As Long
Dim element As String, std As String
Dim zoekElementRng As Range
Dim cl As Range
Dim elementWaarde As Range

Set inputWs = ActiveWorkbook.Sheets("Exported Analyses")
Set outputWB = Workbooks("Evaluatie_Afwijkingen.xlsm")
Set outputWs = outputWB.Sheets("Data")

lR = inputWs.Cells(Rows.Count, 1).End(xlUp).Row
lK = inputWs.Cells(1, Columns.Count).End(xlToLeft).Column
Set zoekElementRng = inputWs.Range(inputWs.Cells(1, 9), inputWs.Cells(1, lK))
Set listTBL = outputWs.ListObjects("xrfcTBL")
On Error GoTo ErrorhandlerLabel
For i = 1 To listTBL.Range.Rows.Count
    kk = 3
    std = listTBL.DataBodyRange(i, 1).Value
    element = listTBL.DataBodyRange(i, 2).Value
    Set rr = inputWs.Range(inputWs.Cells(1, 9), inputWs.Cells(lR, 9)).Find(std)

    If Not rr Is Nothing Then
      startadres = rr.Address
      Do
        For Each cl In zoekElementRng
            Debug.Print cl.Value
            If UCase(element) Like UCase(Trim(cl.Value) & "*") Then
                Set elementWaarde = inputWs.Cells(rr.Row, cl.Column)
                listTBL.DataBodyRange(i, kk).Value = elementWaarde.Value
            End If
            k = cl.Column
        Next
        If k = lK Then If Not rr Is Nothing Then Set rr = inputWs.Range(inputWs.Cells(rr.Row + 1, 9), inputWs.Cells(lR, 9)).FindNext(rr)
      Loop While Not rr Is Nothing And rr.Address <> startadres
    End If
 Next
    Exit Sub
ErrorhandlerLabel:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Error Encountered"
End Sub

In de bijlage het 'inputbestand' en output. Is dit op te lossen?

Mvg
Marco

 

[sylvester-ponte]

FindNext wordt in de help van excel keurig beschreven met duidelijk voorbeeld.

 

[Symphysodon]

Mijn code is niet veel anders dan in de help van Excel en toch krijg ik error 1004 of 424.

 

[Symphysodon]

O toch wel. De range voor Find moet exact hetzelfde zijn als de range voor FindNext.

        If k = lK Then If Not rr Is Nothing Then Set rr = inputWs.Range(inputWs.Cells(1, 9), inputWs.Cells(lR, 9)).FindNext(rr)

Bedankt. :thumb: