FIND meerdere delen tekst in 1 cel

[PaulWar]

Goedendag,
Hoewel ik al veel heb geleerd van dit forum (dank voor alle posters), is mijn VBA kennis nog vrij beperkt.

Ik wil binnen een reeks zoeken naar stukken tekst, en dan de betreffende cel kopiëren. Ik kom een heel eind, maar dan alleen als de stukken tekst in de juiste volgorde staan. Zie onderstaande code.
Wat ik wil is dat ongeacht in welke volgorde de teksten staan de cel gekopieerd wordt.
Heeft iemand een idee hoe ik dit zou kunnen oplossen?

Sub Zoeknaartekst()
Dim c As Range
Counter = Sheets(4).Range("B" & Rows.Count).End(xlUp).Row
tgt = 20
With Sheets(4).Range("B2:" & "B" & Counter)
Set c = .Find("Tekst1*" & "Tekst2", LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
Cells(tgt, 3) = c
Set c = .FindNext(c)
tgt = tgt + 1
Loop While c.Address <> FirstAddress
End If
End With
End Sub

 

[spaarie]

Waarom zou je niet met autofilter werken, ik vermoed dat een autofilter:
1. minder programmeren is
2. duidelijker/makkelijker voor jou en iedereen die dit wilt weten
3. sneller dan een loop

Kan er een voorbeeld geplaatst worden?

 

[PaulWar]

Dat was een tip in de goede richting spaarrie, die functie had ik nog niet eerder gebruikt. Ik ben wat verder gaan zoeken en met AdvancedFilter en CriteriaRange heb ik volgens mij de juiste oplossing gevonden.

Dank je wel!

Voor de volledigheid bijgaand de code die voor mij werkt:
Sub Zoeknaartekst()
Dim rngCriteria As Range
Dim rngFilter As Range
Set rngCriteria = Sheets(1).Range("B1:E2")
Set rngFilter = Sheets(1).Range("A1:A100")

rngFilter.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=rngCriteria, _
CopyToRange:=Sheets(2).Range("c1"), _
Unique:=True
End Sub

Ik zal de status naar opgelost wijzigen.

 

[snb]

Gebruik svp eerst nog even de code markering (Tags)

als je een macro had opgenomen had je gezien dat het ook zonder overbodige variabelen kan:

Sub Zoeknaartekst()
       Sheets(1).Range("A1:A100").AdvancedFilter 2,Sheets(1).Range("B1:E2"),Sheets(2).Range("c1"), true
End Sub