Autofilter op inhoud Cel

[bkoppers]

Ik heb een macro waarbij ik een autofilter aanzet op basis van Cel inhoud, echter hij doet dit alleen als de Cel inhoud exact overeenkomt.
voorbeeld: in Cel F4 staat 4862 dan zoekt hij alle cellen met 4862, graag zou ik willen dat hij dan ook cellen vind met 64862
Weet iemand hoe ik deze macro kan aanpasssen

Sub zoek_charge()
On Error GoTo ErrMsg
r = Range("e4").Value   'regelnummer
Cells(r, 33).Select     'selecteert regel betreffen regelnummer
ActiveSheet.ListObjects("Certificaten").Range.AutoFilter Field:=33, Criteria1:=ActiveSheet.Range("f4")
Cells(r, 33).Select     'selecteert regel betreffen regelnummer
Exit Sub

ErrMsg:
MsgBox ("Charge nummer komt niet voor in deze lijst" & vbNewLine & "Zoek handmatig naar deel van charge in kolom Charge / Heat"), vbInformation
Range("AG9").Select

End Sub

met vriendelijke groet,
B.

 

[sylvester-ponte]

jammer dat er geen voorbeeld bij zit
maar waarschijnlijk moet je

Criteria1:=ActiveSheet.Range("f4")

veranderen in

Criteria1:="*" & ActiveSheet.Range("f4") & "*"

 

[bkoppers]

bedankt voor je reactie, maar helaas werkt het niet. nu selecteert hij niets. ik heb voorbeeld bestand bijgevoegd.

gr. B.

 

[sylvester-ponte]

er moet natuurlijk wel tekst in de kolom staan
en de macro tekst moet zijn:

Criteria1:="=*" & ActiveSheet.Range("f4") & "*"

zie voorbeeld met extra kolom voor de tekst

 

[bkoppers]

Bedankt voor deze oplossing, maar is het mogelijk om in de kolom op tekst en getallen te zoeken.

gr. B.

 

[sylvester-ponte]

ja dat kan op meerdere manieren

je kan een macro maken die de getallen omzet in tekst

of of je laat een macro het filteren doen

en er zijn vast nog wel meer manieren.

 

[sylvester-ponte]

probeer deze eens:

Sub zoek_charge()
    Dim Tekst As String
    Tekst = "*" & [f4] & "*"
    With CreateObject("System.Collections.ArrayList")
        For Each c In ActiveSheet.ListObjects("Certificaten").Range.Columns(33).Cells
            If CStr(c) Like Tekst Then .Add CStr(c)
        Next c
        On Error GoTo NietGevonden:
        ActiveSheet.ListObjects("Certificaten").Range.AutoFilter Field:=33, _
            Criteria1:=.toarray(), Operator:=xlFilterValues
    End With
    Exit Sub
NietGevonden:
On Error GoTo 0
MsgBox ([f4] & " komt niet voor in Field 33")
End Sub

zie bijlage

 

[bkoppers]

Dankjewel deze werkt prima. heb er zelf nog even een macro voor geplakt dat hij ff test of er niet perongeluk al een autoselectie aan staat, en hij werkt nu perfect. mijn dank is groot.

Gr. B.