VBA selectie maken met filter

[RdS]

Goedendag,

Ik ben bezig met een Macro te maken om bepaalde data te selecteren.


Hieronder is te zien dat "Hospitality" met "F7" geselecteerd wordt en gekopieerd.

Het probleem:
Het kan voorkomen dat er geen data is die zowel Hospitality als F7 heeft.

Wat voor stukje VBA kan ik ertussen zetten zodat wanneer geen resultaat, dat er verder wordt gegaan met de rest van de macro.


Wat er nu gebeurd (als zowel Hospitality als F7 leeg is) is dat het resultaat leeg is, cel A12 t/m A65650 wordt gekopieerd en dat geprobeerd om te plakken. Wat uiteraard niet de bedoeling is.

ActiveSheet.Range("$A$12:$H$15000").AutoFilter Field:=3, Criteria1:= _
"Hospitality"
ActiveSheet.Range("$A$12:$H$15000").AutoFilter Field:=6, Criteria1:= _
"=*F7*", Operator:=xlAnd
Range("A12").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy

Wie kan mij helpen?

 

[HSV]

Bv.
Ik weet niet wat je "=*F7*" criterial is, dus heb er voor het gemak even dit van gemaakt.

If Not Columns(3).Find("Hospitality", , xlValues, xlWhole) Is Nothing And Not Range("F7") Is Nothing Then

 

[RdS]

Ik heb geprobeerd om een voorbeeldje toe te voegen.

De ene macro gaat goed, de andere niet.

 

[Warme bakkertje]

Probeer deze eens. De .[C1] moet je nog wel vervangen door de juiste locatie voor het plakken van je gegevens.

Sub tst()
On Error Resume Next
With ActiveSheet
    .Range("$A$12:$H$15000").AutoFilter Field:=3, Criteria1:="Hospitality"
    .Range("$A$12:$H$15000").AutoFilter Field:=6, Criteria1:="=*F7*", Operator:=xlAnd
    Set rng = Intersect(.AutoFilter.Range.EntireRow, Columns(1))
    Set rng1 = rng.Offset(1).Resize(rng.Rows.Count - 1, 8).SpecialCells(xlVisible)
    If Err.Number > 0 Then Exit Sub:
    rng1.Copy .[C1]
End With
End Sub

 

[RdS]

Sheets.Add After:=Sheets(Sheets.Count)
    ActiveCell.FormulaR1C1 = "DFU"
    ActiveCell.Offset(1, 0).Range("A1").Select
    Sheets("DFU").Select
    ActiveSheet.Range("$A$12:$H$15000").AutoFilter Field:=3, Criteria1:= _
        "Hospitality"
    ActiveSheet.Range("$A$12:$H$15000").AutoFilter Field:=6, Criteria1:= _
        "=*F7*", Operator:=xlAnd
    Range("A12").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Sheet1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.End(xlDown).Select
    ActiveCell.Offset(2, 0).Range("A1").Select
    Sheets("DFU").Select
    ActiveSheet.Range("$A$12:$H$15000").AutoFilter Field:=3
    ActiveSheet.Range("$A$12:$H$15000").AutoFilter Field:=6
    
    ActiveSheet.Range("$A$12:$H$15000").AutoFilter Field:=3, Criteria1:= _
        "Hospitality"
    ActiveSheet.Range("$A$12:$H$15000").AutoFilter Field:=6, Criteria1:= _
        "=*A7*", Operator:=xlAnd
    Range("A12").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Sheet1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.End(xlDown).Select
    ActiveCell.Offset(2, 0).Range("A1").Select
    Sheets("DFU").Select
    ActiveSheet.Range("$A$12:$H$15000").AutoFilter Field:=3
    ActiveSheet.Range("$A$12:$H$15000").AutoFilter Field:=6

Ik snap nog steeds niet helemaal waar ik de code moet invoegen?
In het 2e gedeelte waarbij A7 geselecteerd moet worden gaat het verkeerd. Er is namelijk geen data met A7.

 

[RdS]

Is er nog iemand die mij naar de volgende stap kan helpen?

 

[Gert Bouwmeeste]

Er is namelijk geen data met A7

Als er geen data is kun je er ook niet op selecteren, toch?

 

[Haije]

RdS,

kijk eens in de bijlage......

in A11 op blad DFU wordt het aantal records van de selectie geteld, als dat 0 is dan wordt in de macro gesprongen.

 

[RdS]

Yep... dat is hem !

Dankjewel

Voor het begrip: =subtotal(3,13:15000)

Wat doet de eerste 3 ?

 

[Warme bakkertje]

Dit kan toch véél simpeler

Sub tst()
Sheets.Add After:=Sheets(Sheets.Count)
ActiveCell.FormulaR1C1 = "DFU"
On Error Resume Next
With Sheets("DFU")
    .Range("$A$12:$H$15000").AutoFilter Field:=3, Criteria1:="Hospitality"
    .Range("$A$12:$H$15000").AutoFilter Field:=6, Criteria1:="=*F7*", Operator:=xlAnd
    Set rng = Intersect(.AutoFilter.Range.EntireRow, .Columns(1))
    Set rng1 = rng.Offset(1).Resize(rng.Rows.Count - 1, 8).SpecialCells(xlVisible)
    If Err.Number > 0 Then Exit Sub:
    rng1.Copy Sheets(Sheets.Count).[A65536].End(xlUp).Offset(1)
End With
End Sub

 

[RdS]

Toch vind ik de gekozen oplossing makkelijker te begrijpen.

 

[Haije]

(..)
Voor het begrip: =subtotal(3,13:15000)

Wat doet de eerste 3 ?

uit de Excel help:

SUBTOTAAL(functie_getal; verw1; verw2;...)

functie_getal is een getal van 1 tot 11 (inclusief verborgen waarden) of van 101 tot 111 (exclusief verborgen waarden) dat aangeeft welke functie moet worden gebruikt voor de subtotaalberekening in een lijst.

Functie_getal
(inclusief verborgen waarden) Functie_getal
(exclusief verborgen waarden) Functie
1 101 GEMIDDELDE
2 102 AANTAL
3 103 AANTALARG
4 104 MAX
5 105 MIN
6 106 PRODUCT
7 107 STDEV
8 108 STDEVP
9 109 SOM
10 110 VAR
11 111 VARP

verw1;verw2;... zijn 1 tot 29 bereiken of verwijzingen waarvan u het subtotaal wilt bepalen.