vba help - autofilter and check Visible cells count

[Mallesh23]

Hi Team,

I want to autofilter a data and before deleting data
I want to check whether there are any visible cells after autofilter and then delete data.

I know two methods to validate.
1) 'If .Columns(1).SpecialCells(12).Count > 1 Then 'Criteria to validate
2) If WorksheetFunction.Subtotal(3, .Columns(8)) > 1 Then

Are there any other method to check visible cells?.. plz share

Sub Autofilter_Testing()

Sub Check_Visible_Cells

Dim lastrow As Long
lastrow = Range("a" & Rows.Count).End(xlUp).Row


With Range("a1").CurrentRegion
    .AutoFilter field:=8, Criteria1:="<5"
    
    '-----Check Point 1 validate visible cells----------
    'If .Columns(1).SpecialCells(12).Count > 1 Then  'Criteria to validate
    
    '-----Check Point 2 validate visible cells -----
     If WorksheetFunction.Subtotal(3, .Columns(8)) > 1 Then
    
        .Offset(1).Resize(.Rows.Count - 1).EntireRow.Select
        .Cells.AutoFilter
    Else
        .Cells.AutoFilter
    End If

End With

End sub

--------------------Below is Sample Data----------

Book3
	A	B	C	D	E	F	G	H	I	J
1	No.	Athlete	Nation	Sport	Years	Games	Gender	Gold	Silver	Bronze
2	1	Michael Phelps	United States	Swimming	2000-2016	Summer	M	23	3	2
3	2	Larisa Latynina	Soviet Union	Gymnastics	1956–1964	Summer	F	9	5	4
4	3	Marit Bjørgen	Norway	Cross-country skiing	2002–2018	Winter	F	8	4	3
5	4	Nikolai Andrianov	Soviet Union	Gymnastics	1972–1980	Summer	M	7	5	3
6	5	Ole Einar Bjørndalen	Norway	Biathlon	1998–2014	Winter	M	8	4	1
7	6	Boris Shakhlin	Soviet Union	Gymnastics	1956–1964	Summer	M	7	4	2
8	7	Edoardo Mangiarotti	Italy	Fencing	1936–1960	Summer	M	6	5	2
9	8	Takashi Ono	Japan	Gymnastics	1952–1964	Summer	M	5	4	4
10	9	Paavo Nurmi	Finland	Athletics	1920–1928	Summer	M	9	3	0
11	10	Birgit Fischer	East Germany	Canoeing	1980–2004	Summer	F	8	4	0
12		Bjørn Dæhlie	Norway	Cross-country skiing	1992–1998	Winter	M	8	4	0
13	12	Sawao Kato	Japan	Gymnastics	1968–1976	Summer	M	8	3	1
14		Jenny Thompson	United States	Swimming	1992–2004	Summer	F	8	3	1
15	14	Ryan Lochte	United States	Swimming	2004–2016	Summer	M	6	3	3
16	15	Dara Torres	United States	Swimming	1984–2008	Summer	F	4	4	4
17	16	Alexei Nemov	Russia	Gymnastics	1996–2000	Summer	M	4	2	6
18	17	Natalie Coughlin	United States	Swimming	2004–2012	Summer	F	3	4	5
Sheet2

Thanks
mg

 

[davesexcel]

Is this to determine if you have something to copy after the filter?

Sub Check_Visible_Cells()
    Dim sh As Worksheet
    Dim rng As Range, frng As Range
    Dim lastrow As Long

    Set sh = ActiveSheet
    With sh
        lastrow = .Range("A" & Rows.Count).End(xlUp).Row
        Set rng = .Range("A1:J" & lastrow)

        With rng

            .AutoFilter Field:=8, Criteria1:=">24"
            On Error Resume Next
            Set frng = rng.Offset(1).Resize(lastrow - 1, 10).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0

            If Not frng Is Nothing Then
                frng.Copy
            Else
                .Cells.AutoFilter
            End If

        End With

    End With

End Sub

 

[Mallesh23]

Hi Dave,

Thanks for sharing one more option, really helpful.


Thanks
mg