Delete only visible cells

vmjan02

Well-known Member
Joined
Aug 15, 2012
Messages
1,132
Office Version
  1. 365
  2. 2021
  3. 2019
  4. 2016
  5. 2013
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

VBA Code:
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
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
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:
VBA 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
 
Upvote 0
Hello Vmjan,

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

VBA Code:
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.
 
Upvote 0
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:
VBA 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.

VBA Code:
ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
 
Upvote 0
Hello Vmjan,

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

VBA Code:
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

VBA Code:
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
 
Upvote 0
See if this is any faster.

VBA Code:
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
 
Upvote 0
Solution
See if this is any faster.

VBA Code:
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.
 
Upvote 0

Forum statistics

Threads
1,223,912
Messages
6,175,340
Members
452,638
Latest member
Oluwabukunmi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top