Verticaal zoeken macro upgrade

[JansenmeteenJ]

Goedendag,

Ik filter gegevens uit een invoerveld en projecteer dat op een los tabblad. Daarvoor is er een macro die ooit door jullie is aangedragen.

With Sheets("Input").Cells(1).CurrentRegion
      .AutoFilter 3, Criteria1:=Range("B01").Value
      .Copy Sheets("Extern").Range("A1")
      .AutoFilter
    End With
    With Sheets("Input").Cells(1).CurrentRegion
      .AutoFilter 3, Criteria1:=Range("B02").Value
      .Copy Sheets("Extern").Range("A9")
      .AutoFilter
    End With

Nou ja zo is er voor elk onderwerp een stukje code gemaakt die op elke value zoekt en iets uitspuwt. Dat werkt goed, want er zitten 7 dagen in de week en ieder had slechts 1 taak....
Daar knijpt het nu, niet ieder heeft 1 taak per dag, maar soms meer. Aangezien ik een vast rijafstand aanhoud begint data zich te overschrijven....

Hoe kan ik die variabel maken? Hij moet steeds een stapje verder zoeken, B01, B02 etc etc maar dan daartussen een blanke regel achterlaten zodat het ook nog overzichtelijk wordt.

 

[VenA]

Mij lijkt een voorbeeldbestand wel handig en de opzet niet.

 

[JansenmeteenJ]

Sorry ik moest even het formulier anoniem maken en de ballast die niet nodig is voor deze vraag eruit gooien.

Ik herhaal met de macro in Blad3 telkens de verticale zoekopdracht met een vaste regelafstand.
Eigenlijk zou deze macro in een loop moeten draaien zodra ik op de "knop" klik. Waar hij begint met B1 en eindigt in dit geval met B10.
Dan zou het ook makkelijk moeten zijn om een lege regel ertussen te printen.

 

[VenA]

Een leeg bestand is geen voorbeeldbestand.

Waarschijnlijk zoiets.

Sub VenA()
  ar = Sheets("Blad3").Columns(2).SpecialCells(2)
  With Sheets("Input").Cells(1).CurrentRegion
    For j = 1 To UBound(ar)
      .AutoFilter 3, ar(j, 1)
      .Copy Sheets("Extern").Cells(Rows.Count, 1).End(xlUp).Offset(IIf(j = 1, 0, 2))
    Next j
    .AutoFilter
  End With
End Sub

 

[JansenmeteenJ]

Dank,

Ik mag niet een xltm uploaden. denk dat daar iets mis ging met voorbeeld bestand.
De code die gegeven is, werkt maar ten dele.

Hij kopieert nu alleen de eerste regel en niet 8 regels als er 8 regels zijn ingevoerd.
Als op de "knop" wordt gedrukt begint hij het volgende resultaat eronder te plakken in plaats weer bij A1 te beginnen.
Hij laat geen blanke regel tussen de resultaten.

Heb als goed is nu wat willekeurige data ingezet. Gaat vooral om naam en datum om de macro's te laten werken

 

[VenA]

Het wijkt allemaal nogal af van jouw eigen code. Plaats code waar deze hoort. In een gewone module.

Sub VenA()
  Set d = CreateObject("Scripting.Dictionary")
  With Sheets("Input").Cells(1).CurrentRegion
    ar = .Value
    For j = 2 To UBound(ar)
      d(LCase(ar(j, 3))) = ""
    Next j
    For Each it In d
      .AutoFilter 3, it
      .Copy Sheets("Extern").Cells(Rows.Count, 3).End(xlUp).Offset(IIf(Sheets("Extern").Cells(1) = "", 0, 2), -2)
    Next it
    .AutoFilter
  End With
End Sub

 

[JansenmeteenJ]

Top dit werkt al stuk beter!
Alleen nu nog telkens beginnen met schrijven vanaf A1 dan overlapt hij zeg maar eventueel eerder geschreven resultaten..
Moet ik dan ergens bovenin het Range commando inzetten?

 

[VenA]

Het blad eerst leegmaken lijkt mij een logische keuze.

 

[JansenmeteenJ]

Veld eerst leegmaken is gelukt

Range("A1:P250").ClearContents

Aan begin van script toegevoegd.

Ik probeer de code te begrijpen want ik wil eigenlijk dat hij uit blad3 eerst de range b1:b4 doet en dan de range b5:b10
Als ik achter de autofilter ergens een range invul van b1:b4 sheets blad3 dan werkt het hele script niet.

Zucht best pittig dat excel

 

[VenA]

Zie #4

 

[JansenmeteenJ]

Top, ik zie ook de logica achter autofilter die ik zelf niet kon bedenken.

Werkt helemaal super zo, laat nog wel eens wat lege cellen achter als een naam niet voorkomt maar dat is totaal niet storend.