Macro in excel om te zoeken werkt niet correct

[PiSang99]

Hallo allemaal,

Op internet ben ik op zoek gegaan naar een macro die ik aan een button heb gehangen om zodoende een overzicht te krijgen van een bepaalde zoekactie. Onderstaande macro vond ik ergens op internet (weet ff niet meer waar ) Maar deze werkt niet correct. Welke specialist kan mij aangeven wat er precies mis is? De macro werkt 1x wanneer ik de waarde matchcase=false handhaaf (origineel) Ik wil deze echter op true hebben of ik moet ergens kunnen toevoegen dat ik in de hele werkmap op alle tabbladen binnen een bepaalde range kan zoeken)
De macro loopt mis op de vet gedrukte regel (volgens de foutopsporing)

Een voorbeeld van het excel document kan ik helaas niet toevoegen maar ik denk dat dit in deze ook niet nodig is.

Public Sub FindText()

Dim ws As Worksheet
Dim Found As Range
Dim myText As String
Dim FirstAddress As String
Dim AddressStr As String

myText = InputBox("Enter text to find")

If myText = "" Then Exit Sub

For Each ws In ThisWorkbook.Worksheets
With ws
Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, MatchCase:=True)
If Not Found Is Nothing Then
FirstAddress = Found.Address
Do
AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
Set Found = .UsedRange.FindNext(Found)
Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If
End With

Next ws

If Len(AddressStr) Then
MsgBox AddressStr, vbOKOnly, myText & " found in these cells"
Else:
MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
End If

End Sub

 

[PiSang99]

Solved

Heb nog wat verder gezocht en met onderstaande krijg ik resultaat. Liefst zag ik het in een lijstje naar voren komen maar dit is voorlopig al voldoende.

Sub FindAll()
Dim strFind As String
Dim wks As Worksheet
Dim rngFound As Range
Dim lngItems As Long
strFind = InputBox(prompt:="Enter string to find", Title:="Find what?")
If Len(strFind) > 0 Then
For Each wks In ActiveWorkbook.Worksheets
If FindIt(wks, strFind, lngItems) = False Then Exit For
Next wks
End If
MsgBox lngItems & " matches found"
End Sub
Function FindIt(wks As Worksheet, strFind As String, lngMatches As Long) As Boolean
Dim rngFound As Range
Dim strFirstFind As String
FindIt = True
With wks.UsedRange
Set rngFound = .Find(what:=strFind, LookIn:=xlValues, lookat:=xlPart, MatchCase:=True)
If Not rngFound Is Nothing Then
strFirstFind = rngFound.Address
Do
lngMatches = lngMatches + 1
Application.Goto rngFound, True
If MsgBox("Found item. Do you wish to continue search?", vbYesNo) = vbNo Then
FindIt = False
Exit Do
End If
Set rngFound = .FindNext(rngFound)
Loop While rngFound.Address <> strFirstFind
End If
End With
End Function

 

[PiSang99]

Helaas

Na wat meer testen blijkt ook dit script op dezelfde regel te crashen.

 

[PiSang99]

Oplossing

Navraag bij een VBscript expert leert dat onderstaande correct is:

Public Sub Zoeken()

Dim ws As Worksheet
Dim Found As Range
Const myText As String = "Zoekstring"
Dim FirstAddress As String
Dim AddressStr As String

For Each ws In ThisWorkbook.Worksheets
Einde = False
With ws
Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, MatchCase:=True)
If Not Found Is Nothing Then
FirstAddress = Found.Address
Do
AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
Set Found = .UsedRange.FindNext(Found)

If Found Is Nothing Then
Einde = True
Else
If Found.Address <> FirstAdress Then
Einde = True
End If
End If
Loop While Not Einde
End If
End With
Next ws

If Len(AddressStr) Then
MsgBox AddressStr, vbOKOnly, myText & " gevonden op"
Else:
MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
End If
End Sub