Delete only visible cells

[vmjan02]

It's all perfect code finds the column name and filter's it correctly
But not sure as it also deletes the header on delete visible cells only more over it takes time to delete visible cells

any suggestion and modify the code thanks header starts from cell A7

Sub autofiltering()
    Dim col As String, cfind As Range
    Dim coll As String, ccfind As Range

Sheets("Auduince Burn").Select

    col = "Region"
    
    With Worksheets("Auduince Burn") 
        With .Range("A7", .Cells(7, .Columns.Count).End(xlToLeft)) 
            Set cfind = .Find(what:=col, LookIn:=xlValues, lookat:=xlWhole) '<-- look for the wanted column header
             If Not cfind Is Nothing Then '<-- if the header has been found
                .AutoFilter Field:=cfind.Column, Criteria1:="<>" & "WEST"
                .Range("A7").Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete 
' Keeping header it should delete only visible cells till the last record
            End If
        End With
        .AutoFilterMode = False '<-- show all rows back and remove autofilter buttons
    End With

End Sub

 

[Joe4]

I have a standard procedure that I keep in my Personal Macro workbook that only deletes visible rows from a filter, but does not delete the header row.
Perhaps you can adapt this for your needs.

Here is the code:

Public Sub DeleteUnHiddenRows()
'   Deletes all unhidden rows except for the header (first row only)

    Dim lr As Long
    
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row

'   Exit sub if no data to delete data (only header visible)
    If lr = 1 Then Exit Sub

'   Delete unhidden data
    Application.DisplayAlerts = False
    ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
    Application.DisplayAlerts = True

End Sub

 

[vcoolio]

Hello Vmjan,

Here's another method you may like to consider:-

Sub Test()
   
     Dim cfind As Range
   
     Application.ScreenUpdating = False
      
                    With Sheet1.Range("A7", Sheet1.Range("K" & Sheet1.Rows.Count).End(xlUp))
                    Set cfind = .Find(what:="Region", LookIn:=xlValues, lookat:=xlWhole)
                            .AutoFilter cfind.Column, "<>" & "WEST"
                            On Error Resume Next
                            .Offset(1).SpecialCells(12).EntireRow.Delete
                            On Error GoTo 0
                            .AutoFilter
                    End With
       
    Application.ScreenUpdating = True

End Sub

It takes in the whole range (so you may need to change the "K" to suit) and still uses the 'Find' method.

I hope that this helps.

Cheerio,
vcoolio.

 

[vmjan02]

I have a standard procedure that I keep in my Personal Macro workbook that only deletes visible rows from a filter, but does not delete the header row.
Perhaps you can adapt this for your needs.

Here is the code:

Public Sub DeleteUnHiddenRows()
'   Deletes all unhidden rows except for the header (first row only)

    Dim lr As Long
   
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row

'   Exit sub if no data to delete data (only header visible)
    If lr = 1 Then Exit Sub

'   Delete unhidden data
    Application.DisplayAlerts = False
    ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
    Application.DisplayAlerts = True

End Sub

this code is taking a lot of time.

ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete

 

[vmjan02]

Hello Vmjan,

Here's another method you may like to consider:-

Sub Test()
  
     Dim cfind As Range
  
     Application.ScreenUpdating = False
     
                    With Sheet1.Range("A7", Sheet1.Range("K" & Sheet1.Rows.Count).End(xlUp))
                    Set cfind = .Find(what:="Region", LookIn:=xlValues, lookat:=xlWhole)
                            .AutoFilter cfind.Column, "<>" & "WEST"
                            On Error Resume Next
                            .Offset(1).SpecialCells(12).EntireRow.Delete
                            On Error GoTo 0
                            .AutoFilter
                    End With
      
    Application.ScreenUpdating = True

End Sub

It takes in the whole range (so you may need to change the "K" to suit) and still uses the 'Find' method.

I hope that this helps.

Cheerio,
vcoolio.

have modified the sprit as per my need

but its' not deleting all the visible cells

Sub Test()
   
   Sheets("Auduince Burn").Select
   
     Dim cfind As Range
   
     'Application.ScreenUpdating = False
      
                    With Sheet7.Range("A7", Sheet7.Range("AA" & Sheet7.Rows.Count).End(xlUp))
                    Set cfind = .Find(what:="Region", LookIn:=xlValues, lookat:=xlWhole)
                            .AutoFilter cfind.Column, "<>" & "WEST"
                            On Error Resume Next
                            .Offset(1).SpecialCells(12).EntireRow.Delete  'Not deleting all visible cells
                            On Error GoTo 0
                            .AutoFilter
                    End With
       
    'Application.ScreenUpdating = True

End Sub

 

[Alex Blakenburg]

See if this is any faster.

Sub autofiltering_OP_Mod_v02_withsort()
    Dim col As String, cfind As Range
    Dim coll As String, ccfind As Range
    Dim wsAudBurn As Worksheet
    Dim rng As Range, lr As Long, lc As Long
    Dim rngSortCol As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set wsAudBurn = Worksheets("Auduince Burn")

    col = "Region"
    
    With wsAudBurn
        lr = .Cells(Rows.Count, "A").End(xlUp).Row
        lc = .Cells(7, Columns.Count).End(xlToLeft).Column
        Set rng = .Range(.Cells(7, "A"), .Cells(lr, lc))
        Set rngSortCol = rng.Columns(rng.Columns.Count + 1)
    End With

        With rng
            Set cfind = .Find(what:=col, LookIn:=xlValues, lookat:=xlWhole) '<-- look for the wanted column header
             If Not cfind Is Nothing Then '<-- if the header has been found
                .AutoFilter Field:=cfind.Column, Criteria1:="<>" & "WEST"
                ' Mark Visible Rows with 1
                rngSortCol.Offset(1).Resize(rngSortCol.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Value = 1
                wsAudBurn.ShowAllData
                .Resize(, lc + 1).Sort key1:=rngSortCol, Order1:=xlAscending, Header:=xlYes
                rngSortCol.Offset(1).Resize(Application.Count(rngSortCol)).EntireRow.Delete
                wsAudBurn.AutoFilterMode = False '<-- show all rows back and remove autofilter buttons
                ' Reset end of sheet
                wsAudBurn.Select
                ActiveSheet.UsedRange
            End If
        End With
        
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

 

[vmjan02]

See if this is any faster.

Sub autofiltering_OP_Mod_v02_withsort()
    Dim col As String, cfind As Range
    Dim coll As String, ccfind As Range
    Dim wsAudBurn As Worksheet
    Dim rng As Range, lr As Long, lc As Long
    Dim rngSortCol As Range
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set wsAudBurn = Worksheets("Auduince Burn")

    col = "Region"
   
    With wsAudBurn
        lr = .Cells(Rows.Count, "A").End(xlUp).Row
        lc = .Cells(7, Columns.Count).End(xlToLeft).Column
        Set rng = .Range(.Cells(7, "A"), .Cells(lr, lc))
        Set rngSortCol = rng.Columns(rng.Columns.Count + 1)
    End With

        With rng
            Set cfind = .Find(what:=col, LookIn:=xlValues, lookat:=xlWhole) '<-- look for the wanted column header
             If Not cfind Is Nothing Then '<-- if the header has been found
                .AutoFilter Field:=cfind.Column, Criteria1:="<>" & "WEST"
                ' Mark Visible Rows with 1
                rngSortCol.Offset(1).Resize(rngSortCol.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Value = 1
                wsAudBurn.ShowAllData
                .Resize(, lc + 1).Sort key1:=rngSortCol, Order1:=xlAscending, Header:=xlYes
                rngSortCol.Offset(1).Resize(Application.Count(rngSortCol)).EntireRow.Delete
                wsAudBurn.AutoFilterMode = False '<-- show all rows back and remove autofilter buttons
                ' Reset end of sheet
                wsAudBurn.Select
                ActiveSheet.UsedRange
            End If
        End With
       
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

kool thanks a ton, it is much faster and thanks once again.