gefilterde rijen verwijderen d.m.v. aanvulling add-in macro

[peter59]

Hallo,

Ik heb een macro opgenomen en deze gebruik ik in een add-in. Zie onderstaand.
Nu is het de bedoeling om na uitvoering van onderstaande code (gefilterde rijen) een pop-up te laten verschijnen met b.v. de tekst "Weet u het zeker?"
Als er op ja wordt geklik dan de gefiltreerde rijen en de kolommen P en Q verwijderen.

Sub zoekdubbelefacturatie()
    Range("P3").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-13],RC[-12],RC[-10],RC[-9])"
    Range("P3").Select
    Selection.AutoFill Destination:=Range("P3:P1995")
    Range("P3:P1995").Select
    Range("Q3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]="""","""",COUNTIF(RC[-1]:R[119]C[-1],RC[-1]))"
    Range("Q3").Select
    Selection.AutoFill Destination:=Range("Q3:Q1955")
    Range("Q3:Q1995").Select
    Range("B2").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$Q$1995").AutoFilter Field:=17, Criteria1:=Array( _
        "2", "3", "4", "5", "6"), Operator:=xlFilterValues
    Range("B1").Select
End Sub

Dank alvast voor de genomen moeite.

Mvg
Peter

 

[SjonR]

probeer dit eens:

Sub zoekdubbelefacturatie()
    Range("P3").FormulaR1C1 = "=CONCATENATE(RC[-13],RC[-12],RC[-10],RC[-9])"
    Range("Q3").FormulaR1C1 = "=IF(RC[-1]="""","""",COUNTIF(RC[-1]:R[119]C[-1],RC[-1]))"
    Range("P3:Q3").AutoFill Destination:=Range("P3:Q1955")
    Range("$A$1:$Q$1995").AutoFilter Field:=17, Criteria1:=Array( _
        "2", "3", "4", "5", "6"), Operator:=xlFilterValues
    
    If MsgBox("Weet u het zeker?", vbYesNo) = vbYes Then Cells(1).CurrentRegion.Offset(1).Delete xlShiftUp

End Sub

 

[peter59]

Hallo SjonR

Heel hartelijk dank voor je medewerking.
De code werkt als een tierelier en is ook nog eens een stukje korter.
Onderstaand is het geworden met de bijvoeging van verwijderen kolom P en Q en het opheffen van de filtering e.d.
Zoals je kunt zien is deze ook weer opgenomen met de macrorecorder. Ik kan helaas (nog) geen code zelf schrijven.

Sub zoekdubbelefacturatie()

    Range("P3").FormulaR1C1 = "=CONCATENATE(RC[-13],RC[-12],RC[-10],RC[-9])"
    Range("Q3").FormulaR1C1 = "=IF(RC[-1]="""","""",COUNTIF(RC[-1]:R[119]C[-1],RC[-1]))"
    Range("P3:Q3").AutoFill Destination:=Range("P3:Q1955")
    Range("$A$1:$Q$1995").AutoFilter Field:=17, Criteria1:=Array( _
        "2", "3", "4", "5", "6"), Operator:=xlFilterValues
    
    If MsgBox("Weet u het zeker?", vbYesNo) = vbYes Then Cells(1).CurrentRegion.Offset(1).Delete xlShiftUp
    
    Columns("P:Q").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    Selection.AutoFilter
    
    Range("A2").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Blad1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Blad1").AutoFilter.Sort.SortFields.Add2 Key:=Range _
        ("C2:C1995"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Blad1").AutoFilter.Sort
        .Header = xlYes
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter
    
End Sub

Nogmaals, dank hiervoor.

Mvg
Peter

 

[SjonR]

Je zou kunnen beginnen met het samenvoegen van de regels eindigend op SELECT en beginnend met Selection.

dus bijvoorbeeld:

Columns("P:Q").Select
Selection.Delete Shift:=xlToLeft

wordt:

Columns("P:Q").Delete

Bij hele kolommen of rijen verwijderen valt er niet te kiezen welke kant de overige regels of kolommen op moeten, dus kan je de shift wegelaten.

 

[peter59]

SjonR,

Wederom dank voor de tip.
En ook dit werkt weer. Is toch weer een regeltje minder.

Mvg
Peter

 

[VenA]

is dit niet voldoende? Wel even de eerste rij verwijderen.

Sub VenA()
  With Sheets("Sheet1").Cells(1).CurrentRegion
    .RemoveDuplicates Array(3, 4, 6, 7), xlYes
    .Sort .Cells(1, 3), , , , , , , xlYes
  End With
End Sub

 

[peter59]

Hallo VenA

Dank voor je medewerking.

De code is wel een heel stuk korter alleen met mijn slechte kennis van VBA krijg ik deze code niet "vertaalt".
Ik moest idd de 1ste rij verwijderen.
In het origineel staat hier een subtotaal functie.
Hier dien ik dus iets anders op te verzinnen.
Tevens is het jammer dat er geen pop-up verschijnt waardoor ik het e.e.a. kan zien wat er verwijderd wordt.
Het is de bedoeling dat in een later stadium hier meer personen gebruik van gaan maken.

Nogmaals dank voor je input.

Mvg
Peter

 

[VenA]

Plaats een voorbeeld van het bestand. De pop-up verplaatsen is toch niet zo heel moeilijk. Wat het nut ervan is, is dan weer een andere discussie.