VBA zoek script voor exel geeft fout Do zonder Loop

[sleepingbel]

Hallo allemaal,

Ik probeer een zoekopdracht te integreren in een exel workbook maar de formule bevat een fout en ik kom er niet uit.
Ik heb een tuturial gevolgd omdat ik zelf weinig kennis heb van VB de bedoeling van het zoeken is dat men in Kolom C de nummer platen van het voertuig zoekt en dan in een mesagebox de lijn weergeeft waar dit staat. ik heb deze formule gebruikt

Private Sub Zoeken_Click()
' Zoeken Macro
'
Dim Promt As String
Dim RetValeu As String
Dim Rng As Range
Dim RowCrnt As Long

Promt = ""
With Sheets("Sheet1")
Do While True

RetValue = InputBox(Promt & "Geef het voertuignummer op")
If RetValue = "" Then
Exit Do
End If

Set Rng = .Columns("C:C").Find(What:=RetValue, After:=.Range("Al"), _
LookIn:=x1Formulas, LookAt:=x1Whole, SearchOrder:=x1ByRows, _
SearchDirection:=x1Next, MatchCase:=False, SearchFormat:=False)

If Rng Is Nothing Then
Promt = " Voertuig niet gevonden "" & RetValue """
Else
RowCrnt = Rng.Row
Promt = " Het voertuig  "" & RetValue & "" is gevonden op lijn " & RowCrnt
End If


End Sub

Kan iemand hierbij helpen om de oplossing te vinden? Ik blijf ondertussen zelf ook zoeken.

 

[pasan]

plaats een voorbeeld bestandje met fictieve gegevens maar wel ingedeeld zoals jou origineel

 

[edmoor]

De melding is toch duidelijk lijkt me. Je gebruik een Do constructie een de bijbehorende Loop is nergens in die code te bekennen.

 

[wampier]

Wat in je code iig niet klopt is: x1next en x1byrows etc. dat moet geen 1 zijn maar een L

 

[Tha Devil]

Verplaatst van Visual Basic naar Visual Basic for Applications

 

[edmoor]

Wat in je code iig niet klopt is: x1next en x1byrows etc. dat moet geen 1 zijn maar een L

Scherp gezien. Zo ook waar x1Formulas staat en x1Whole.

Het staat overigens los van de missende Loop.

 

[pasan]

Kun je hier wat mee?

Private Sub Zoeken_Click()
' Zoeken Macro
 
  Retvalue = InputBox("Geef het voertuignummer op")
  If StrPtr(Retvalue) = 0 Then Exit Sub                             'er is op annuleren gedrukt, code stopt
  With Worksheets("Blad1").Columns(3)
   If Retvalue <> "" Then
    Set b = .Find(Retvalue, LookIn:=xlValues)
    If Not b Is Nothing Then
        secondAddress = b.Address
        Do
        R = b.Row
            Set b = .FindNext(b)
        Loop While Not b Is Nothing And b.Address <> secondAddress
        Application.Goto Cells(R, 3)                                  'ga naar cel met gevonden waarde
     End If
    End If
    
      MsgBox IIf(R <> Empty, " Het voertuig " & Retvalue & " is gevonden op lijn " & R, "Voertuig niet gevonden")
   End With
End Sub

 

[Warme bakkertje]

Private Sub Zoeken_Click()
' Zoeken Macro
    Retvalue = InputBox("Geef het voertuignummer op")
    With Worksheets("Blad1")
        x = Application.Match(Retvalue, .Columns(3), 0)
        If IsError(x) Then GoTo EndSub
        Application.Goto .Cells(x, 3)                                  'ga naar cel met gevonden waarde
        MsgBox IIf(x <> Empty, " Het voertuig " & Retvalue & " is gevonden op lijn " & x, "Voertuig niet gevonden")
   End With
EndSub:
End Sub

 

[sleepingbel]

Ik heb het gevonden bedankt allemaal voor de snelle reactie

Ik heb wel de code van Pasan nog wat moeten aanpassen voor ze werkte.

Ik heb op lijn 5 " Worksheets("Blad1").Columns(3) " moeten veranderen naar " ActiveSheet.Columns(3)" dit om niet buiten bereik te gaan
en op lijn 13 "And b.Address <> secondAddress " moeten verwijderen omdat hierdoor de code vast liep

Bedankt allemaal

Trouwens een goed forum voor deze dingen

 

[Warme bakkertje]

Zonder afbreuk te doen aan de bijdrage van Pasan zou ik afhankelijk van de lenge van je zoekmatrix (kolom 3) overwegen mijn code ook eens te proberen.
Dit om de eenvoudige reden dat bij een groter bereik application.Match sneller is dan door elke waarde te loopen met find en findnext.

 

[pasan]

hoe groot is de kans dat een nummerplaat vaker in de lijst voorkomt?

 

[snb]

zou dit niet volstaan ?

Private Sub Zoeken_Click()
    on error resume next
    columns(3).find(InputBox("Geef het voertuignummer op")).select
End Sub

PS. Bij ons in het dorp is de verleden tijd van lopen 'liep'.

 

[sleepingbel]

toch allemaal bedankt

ik heb mijn oplossing en ik ben er blij om

En Warm bakkertje ik zal jouw code ook eens proberen trouwens die van snb ook

snb bedankt voor de taal correctie

 

[sleepingbel]

hoe groot is de kans dat een nummerplaat vaker in de lijst voorkomt?

Dat klopt, maar je kunt wel lege waardes hebben en daar liep het op vast

 

[pasan]

kon het niet laten
Ik denk dat de aanpassing nodig is want na het origineel getest te hebben werd het laatste nummerbord gevonden welke maar gedeeltelijk voldoet aan de zoekopdracht

Private Sub Zoek_Click()
    On Error Resume Next
  Application.Goto Columns(3).Find(InputBox("Geef het voertuignummer op"), LookIn:=xlValues, LookAt:=xlWhole)
End Sub

 

[snb]

ook dan lijkt me dit voldoende:

Sub Zoek_Click()
    On Error Resume Next
    Columns(3).Find(InputBox("Geef het voertuignummer op"),,,1).select
End Sub