Unieke waardes obv 2 criteria met advanced filter/VBA

[Mit89]

Goedenavond allen,

Uit onderstaande data set, zie tevens het VB bestand, wil ik graag de unieke EMPID filteren met een advanced filter (VBA). Maar alleen de EMPID's die zowel voorkomen met LOGTYP "I1" als "PU"

A B C D
EMPID ENDDTM FRMWSID LOGTYP
ZTT363 17-9-2019 14:04 I1
ZAD916 17-9-2019 14:05 I1
637799 17-9-2019 14:05 I1
637799 17-9-2019 14:07 I1
ZAD468 17-9-2019 14:08 I1
ZTT363 17-9-2019 14:08 PU
ZTT382 17-9-2019 14:08 I1
ZTT369 17-9-2019 14:10 I1
637799 17-9-2019 14:10 PU

Op basis van bovenstaande zou de filter dus EMPID ZTT363 en 637799 moeten tonen.

Los van elkaar lukt het me wel om de unieke EMPID's te filteren dus alle unieke ID's met LOGTYP "PU" of "I1", maar het lukt me niet om deze voorwaardes te combineren.

Ik hoop dat jullie me opweg kunnen helpen.

Bij voorbaat dank.

Gr Tim

 

[AlexCEL]

Draaitabelletje?

 

[Mit89]

Goedenavond,

Dank voor de snelle reactie. Dat is nog niet helemaal wat ik voor ogen had. Ik heb het VB bestand aangepast.
Daarin staat stapsgewijs wat ik wil doen, de uitkomst is al goed alleen zou ik het graag in 1 stap willen doen, bij voorkeur met een advanced filter / macro, zodat ik mbv de copy to functie de 14 unieke EMPID's naar een ander blad kan verplaatsen.

Ik kijk uit naar jullie reacties.

Gr Tim

 

[emields]

zo dan?

 

[Mit89]

Goedenavond allen,

Dank voor de snelle reacties. De 2e code van snb doet exact waar ik naar opzoek ben, dank !

ik heb nog één aanvullende vraag: Kan de laatste regel van de code zo aangepast worden, of kan er en regel toegevoegd worden, waardoor de waardes direct in een ander tabblad geplakt worden ?

Hoor het graag.

Gr Tim

 

[emields]

bv sheets("blad1").cells…….

 

[Mit89]

Emields,

Dank voor je snelle reactie. Met die toevoeging krijg ik op de regel

For j = 2 To UBound(sn)

een Run-time error '13': Type mismatch.

De laatste regel van de code is dan

Sheets("Sheet1").Cells(1, 6).Resize(.Count) = Application.Transpose(.Keys)

.

Gr Tim

 

[Timshel]

Sub M_snb()
 sn = Cells(1).CurrentRegion
 
 With CreateObject("scripting.dictionary")
    For j = 2 To UBound(sn)
       If InStr("I1PU", sn(j, 4)) Then .Item(sn(j, 1)) = Replace(.Item(sn(j, 1)), sn(j, 4), "") & sn(j, 4)
    Next
    For Each it In .Keys
       If Len(.Item(it)) = 2 Then .Remove it
    Next
    
   [COLOR=#FF0000] Sheets("Sheet1").[/COLOR]Cells(2, 6).Resize(.Count) = Application.Transpose(.Keys)
 End With
End Sub

 

[Mit89]

Goedenavond allen,

Het werkt ! Eerst niet, omdat ik de macro afspeelde terwijl ik Sheet1 geactiveerd had. Dit heb ik kunnen oplossen door van:

sn = Cells(1).CurrentRegion

=>

sn = Sheets("HULP").Cells(1).CurrentRegion

te maken.

Ik markeer de vraag als opgelost, dank voor alle reacties !

Gr Tim

 

[snb]

Waarom bevatte jouw voorbeeldbestand dan maar 1 werkblad ?
Lijkt me niet zo erg representatief als je met 2 werkbladen wil werken.