VBA code zoeken aan passen

[Jap3600]

Beste,

Ik heb onderstaande code staan:

Option Explicit
Option Base 1

Sub ZoekAlles_01(zoekterm As String)
  Dim ToonRij As Variant, FirstAddress As String, c As Range, rij As Long, i As Integer, LaatsteRij As Long
  Sheets("Algemene lijst").Select
  Application.ScreenUpdating = False
  ActiveSheet.AutoFilterMode = False
 
  LaatsteRij = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
  ReDim ToonRij(LaatsteRij, 1)
  For i = 1 To IIf(zoekterm = "", LaatsteRij, 8): ToonRij(i, 1) = 1: Next 'tot 8e rij altijd zichtbaar!!
  If zoekterm <> "" Then
  
    With Sheets("Algemene lijst").Range("G:G") 'Dus zoeken of gevraagde waarde uit textbox voorkomt in kolom G!
      Set c = .Find(What:=zoekterm, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
      If Not c Is Nothing Then
        FirstAddress = c.Address
        Do
          If rij <> c.Row Then                             'iedere rij maar 1 keer kopieren
            ToonRij(c.Row, 1) = 1
            rij = c.Row
          End If
          Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> FirstAddress
      End If
    End With
  End If
  
  Range("A1").Resize(UBound(ToonRij, 1), UBound(ToonRij, 2)) = ToonRij
  Columns("A:B").AutoFilter
  Range("A1").AutoFilter Field:=1, Criteria1:="1"  'Kan dit wel 2x keer voorkomen??
  Range("B1").AutoFilter Field:=1, Criteria1:="1"
  Columns("A:B").EntireColumn.Hidden = False 'True
  Columns("C:D").ColumnWidth = 1
  
  Application.ScreenUpdating = True
End Sub

Bovenstaande code heb ik toegepast. Echter wil ik nog een zoekfunctie inbouwen welke sorteert en dit als een autofilter in kolom B neer zet.
Heeft iemand een idee hoe ik bovenstaande code kan aanpassen zodat deze dit doet en vervolgens in de kolom B een "1" zet als aan de voorwaarde wordt voldaan.