Macro filtervraag in Excel

[Peter Bulthuis]

Hoi,

Ik zit met een macro-'probleem' in Excel. Ik wil een macro maken met gebruik van het geavanceerde filter in Excel.

De bedoeling is het volgende. Ik heb in Excel bijvoorbeeld een databaselijstje met de volgende records:

Naam|
Fiets laten maken
Naar het dorp
Naam|Kees
Kopen|
Naam|Jan
Kopen|Tandpasta
Kopen|Vlees
Naam|Marije
Huis kopen

Nu wil ik uit deze lijst via een macro de records filteren die beginnen met Naam|
(Het streepje | is hierbij niet het volgende veld. Het is bedoeld als scheiding in hetzelfde veld. Had ook bijvoorbeeld / kunnen zijn.)

Ik krijg dan het volgende lijstje:

Naam|
Naam|Jan
Naam|Kees
Naam|Marije

Het lukt mij zo'n filtering te maken wanneer ik eerst de record Naam| selecteer en daarna een macro activeer.

Maar nu wil ik dat ook kunnen, wanneer ik bijvoorbeeld record Naam|Jan selecteer.
Kan dit/ is dit mogelijk en hoe doe ik dat?

Alvast bedankt!

Groet,


Peter

 

[HSV]

Sub test()
   y = 1
    For Each c In [Blad1!A1:A10]
      If c Like "Naam|*" Then
     Cells(y, 4) = c
     y = y + 1
   End If
  Next
End Sub

 

[Peter Bulthuis]

Hoi Harry,

Bedankt voor je antwoord!
Hier ga je volgens mij uit dat het altijd naam| voor het streepje is. Dat heb ik ook niet echt duidelijk uitgelegd, zie ik nu.

Mijn bedoeling gaat namelijk iets verder:

Als ik op Naam|Kees klik, wil ik met een macro het volgende lijstje kunnen filteren:

Naam|
Naam|Jan
Naam|Kees
Naam|Marije

Maar klik ik op Kopen|Tandpasta, dan wil ik met dezelfde macro het volgende lijstje kunnen filteren:

Kopen|
Kopen|Tandpasta
Kopen|Vlees

 

[HSV]

Met een dubbelklik op de cel.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Range("D1:D" & Cells(Rows.Count, 4).End(xlUp).Row).ClearContents   'of Range("D1").CurrentRegion.ClearContents
y = 1
    For Each c In [Blad1!A1:A10]
    On Error Resume Next
      If c Like Mid(Target, 1, WorksheetFunction.Search("|", Target, 1)) & "*" Then
     Cells(y, 4) = c
     y = y + 1
   End If
  Next
End Sub

Of als er geen "|" in de activecel staat; msgbox

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Range("D1").CurrentRegion.ClearContents
y = 1
    For Each c In [Blad1!A1:A10]
    On Error GoTo einde
      If c Like Mid(Target, 1, WorksheetFunction.Search("|", Target, 1)) & "*" Then
     Cells(y, 4) = c
     y = y + 1
   End If
  Next
  Exit Sub
einde:  MsgBox "Er staat geen ""|"" in de tekst"
End Sub