Hide arrows from filter in VBA - excel

I am trying to hide the arrows of the fields in the range that I applied filter manually.
For example I have filtered the range A5:S500 by the column R and then I need a code that hides the arrows from the filer (the first row which is row 5)
I have tried this
Sub HideArrows()
Dim c As Range
With ThisWorkbook.Worksheets(1)
For Each c In .Range("A5:S5")
.Range("A5:S5").AutoFilter Field:=c.Column, VisibleDropDown:=False
Next c
End With
End Sub
But this takes too long time moreover it removes the filtered range
Is there a way to hide the arrows of the filter without removing the filtered range?

Here are two possible ways to workaround this issue; you will need to modify the worksheet, row, and range to meet your specific needs.
The first one inserts an empty row where you want to insert the autofilter, after inserting the autofilter, it will hide the row.
With ThisWorkbook.Sheets("Sheet1")
.Rows(5).EntireRow.Insert
With Range("A5:S5")
.AutoFilter Field:=3, Criteria1:="2"
.EntireRow.Hidden = True
End With
End With
The other way; is to set your range in one column, which will insert only one drop down (in the first cell of the range) and still filter the used range. When you add VisibleDropDown:=False, the single drop down will be hidden.
With ThisWorkbook.Sheets("Sheet1").Range("C4:C20")
.AutoFilter
.AutoFilter Field:=1, VisibleDropDown:=False
End With

Related

Best way to count number of rows after filtering?

I need to manipulate and copy paste a bunch filtered data and I need the last row of the data after filtering. My dataset is quite large (65000 rows total) so I don't want to use any for loops since that will take too long / crash. What would be the best way to find the last row index (aka length) of a filtered data set then?
Something like this.
Sub FindingLastRow()
'PURPOSE: Different ways to find the last row number of a range
'SOURCE: www.TheSpreadsheetGuru.com
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ActiveSheet
'Ctrl + Shift + End
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
End Sub
The variable named 'LastRow' should have the value that you want.
See more info here.
https://www.thespreadsheetguru.com/blog/2014/7/7/5-different-ways-to-find-the-last-row-or-last-column-using-vba
Copy Filtered Ranges – you don’t need SpecialCells(xlCellTypeVisible)
Time and again on this site I’ve seen questions relating to copying (or deleting) filtered ranges where the advice invariably includes the need to use the CellTypeVisible method. This advice can come from some of the most respected and reputable SO users. Contrary to popular belief, this method simply isn’t necessary.
It follows that, if you don’t need to explicitly define the cell type within a range to achieve your goal, you also don’t need to waste code defining the range explicitly in the first place by finding last row/column.
Proof
Consider the following simple data structure, let’s say it’s on Sheet1 and you want to filter column A to 1 and copy the result to Sheet2.
Try the following code – which doesn’t use the CellTypeVisible method:
Option Explicit
Sub CopyNoSpecial()
With Sheet1.Cells(1, 1).CurrentRegion
.AutoFilter 1, 1 'Filter for the number 1 in Column A
.Copy Sheet2.Cells(1) ' Copy - no need to select 'visible cells'
End With
End Sub
Even when you explicitly define the range – you get exactly the same result:
Option Explicit
Sub CopyNoSpecial()
With Sheet1. Range(“A1:C7”)
.AutoFilter 1, 1 'Filter for the number 1 in Column A
.Copy Sheet2.Cells(1) ' Copy - no need to select 'visible cells'
End With
End Sub
If you want to exclude headers, you can use:
Option Explicit
Sub CopyNoSpecial()
With Sheet1.Cells(1, 1).CurrentRegion
.AutoFilter 1, 2 'Filter for the number 2 in Column A
.Offset(1).Copy Sheet2.Cells(2, 1) ' option to exclude headers
End With
End Sub
To exclude both the headers and the row below the range, use:
Option Explicit
Sub CopyNoSpecial()
With Sheet1.Cells(1, 1).CurrentRegion
.AutoFilter 1, 2 'Filter for the number 2 in Column A
.Offset(1).Resize(.Rows.Count - 1).Copy Sheet2.Cells(2, 1) ' excludes headers & row below range
End With
End Sub
Even if you only want to copy part of the filtered range, you simply set the range of interest at the start, such as copying from columns A and B only. This is the only time where it may be necessary to carefully define the range prior to applying the filter.
Option Explicit
Sub CopyNoSpecial()
With Sheet1.Range("A1:B7") 'Define the range of interest
.AutoFilter 1, 2 'Filter for the number 2 in Column A
.Offset(1).Copy Sheet2.Cells(2, 1)
End With
End Sub
Finally, as a believer in less-is-more, here’s a simple code to filter a sheet in one line, using the example data filtering column A for the number 2:
Sheet1.Columns(1).AutoFilter 1, 2
There’s no need to find the last column, or the last row – the filter applies across the full width and height of the sheet in any case.
If you want to read more, you can find an excellent resource Here

combobox, how do i exclude blanks from list retrieved via listobject

Trying to apply data to a combobox, which works out great, except it also include filtered values.
i filter on field 1, filter by a number, there are several empty cells in this row,
those with empty cells in field1 i dont want to see this time.
I pupulate the databodyrange value from column 13 into the combobox list, however even when filtered correctly
it also adds the rows i filtered away.
code..
Private Sub UserFrom_Initialize()
Dim db As ListObject
Set db = Worksheets("baseOfData").ListObjects("database")
db.Range.AutoFilter Field:=1, Criteria1:="<>"
Me.cmbTasks.List = db.ListColumns(13).DataBodyRange.Value
End Sub
I can solve it by running a for loop, and checking every cell before adding it
but that would kinda defeat the purpose of doing it all with 2 lines of code.
any suggestions
however even when filtered correctly it also adds the rows i filtered away.
Me.cmbTasks.List = db.ListColumns(13).DataBodyRange.Value
That is because you are incorrectly doing it. You are referring to complete column and not the filtered range. Try this
Dim db As ListObject
Set db = Worksheets("baseOfData").ListObjects("database")
db.Range.AutoFilter Field:=1, Criteria1:="<>"
Me.cmbTasks.List = db.DataBodyRange.Columns(13).SpecialCells(xlCellTypeVisible).Value
The next problem that you may face will be that it will show values from the first Area only if there are multiple areas.
To handle this, try
Dim db As ListObject
Dim aCell As Range, rngArea As Range
Set db = Worksheets("baseOfData").ListObjects("database")
db.Range.AutoFilter Field:=1, Criteria1:="<>"
'~~> Loop through each area
For Each rngArea In db.DataBodyRange.Columns(13).SpecialCells(xlCellTypeVisible).Areas
'~~> Loop though each cell in the area
For Each aCell In rngArea
cmbTasks.AddItem aCell.Value
Next aCell
Next rngArea
Why not a little simpler (if iteration is an option):
Dim db As ListObject, cel As Range
Set db = Worksheets("baseOfData").ListObjects("database")
For Each cel In db.DataBodyRange.Columns(13).Cells
If cel.EntireRow.Hidden <> True Then
cmbTasks.AddItem cel.value
End If
Next
Would you like to do some modifications on the table, according to selected combo value? If yes, the real row number associated to each combo value must be memorized. In a hidden column of the combo, for instance (using cel.Row).

Delete Table Row Based on Criteria VBA

I am attempting to delete a specific table row based on values in two columns. I attempted to apply filters to the table columns to narrow my criteria, but once I click delete, the ENTIRE ROW is deleted causing values outside of the table to be deleted. Also, the macro recorder isn't as dynamic as I'd like it to be, since it ONLY selects the cell I clicked while recording.
Sub Macro2()
'
' Macro2 Macro
'
'
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:= _
"Apple" \\Narrowing criteria in Column 1 of the table
Range("A4").Select \\This only applies to a specific cell, and the value can shift
Selection.EntireRow.Delete \\This will delete the entire sheet row, I'd like for only the table row to be deleted
Range("A5").Select
Selection.EntireRow.Delete
Selection.EntireRow.Delete
End Sub
Is there a way to find the desired string in a column and delete only the rows in the table once the criteria is met? I attempted to only delete the ListObject.ListRows, but it only references the row I've selected, and not the one based off criteria.
You could use .DataBodyRange and .SpecialCells(xlCellTypeVisible) to set a range variable equal to the filtered ranges, then unfilter and delete:
Dim dRng As Range
With ActiveSheet.ListObjects("Table1")
.Range.AutoFilter Field:=1, Criteria1:="Apple"
If WorksheetFunction.Subtotal(2, .DataBodyRange) > 0 Then
Set dRng = .DataBodyRange.SpecialCells(xlCellTypeVisible)
.Range.AutoFilter
dRng.Delete xlUp
End If
End With
You will have to indicate which cells/range you want to delete. You can find the relevant row by using the find function. Since your table is static I would propose the following macro.
A for loop checking each row is also possible, but not so efficient for a very large table. It can be useful to prepare your dataset by adding a flag to column c (e.g. a 1 if to be deleted).
EDIT suggestion by Tate also looks pretty clean
Sub tabledelete()
Dim ws As Worksheet
Dim rangecheck As Range
Dim rcheck As Integer
Set ws = Sheets("Sheet1") 'fill in name of relevant sheet
Set rangecheck = Range("A1") ' dummy to get the do function started
Do While Not rangecheck Is Nothing
With ws
With .Range("C2:C30") ' fill in relevant range of table
Set rangecheck = .Find(what:=1, LookAt:=xlWhole)
End With
If Not rangecheck Is Nothing Then 'only do something if a 1 is found
rcheck = rangecheck.Row
.Range(.Cells(rcheck, 1), .Cells(rcheck, 3)).Delete Shift:=xlUp 'delete 3 columns in row found
End If
End With
Loop
End Sub

Move all non-blank rows to the top of the ws fast

I'm trying to move all non blank rows to the top of my worksheet (actually to the top of an Autofilter).
I have realised that simply deleting the blank rows is quite slow, and that a faster alternative is assigning the range to a variant.
I have come up with this code, however for some reason it's losing some of the rows:
Public Sub CompactRows(ByRef ws As Worksheet)
Dim a As Variant
With ws
a = .AutoFilter.Range.Offset(1, 0).Columns(1).SpecialCells(xlCellTypeConstants).EntireRow
.AutoFilter.Range.Offset(1, 0).Clear
.AutoFilter.Range.Cells(2, 1).Resize(UBound(a), .UsedRange.Columns.Count) = a
End With
End Sub
So if I have 1000 rows, separated by blank rows, creating 100 sub-ranges, after the function ends I only have 100 rows (the other 900 are lost).
I noticed that in this case Ubound(a) also returns 100. My theory is that it copies only the first row in each sub-range but I'm not sure. Any solution to this, or another faster alternative to achieve the same result quickly will be greatly appreciated.
Sorting it to find the blanks shouldn't affect the rest of the rows - they should stay in the correct order. However, if you end up sorting on more than one column because what constitutes a blank row is more complicated, then it could happen.
This procedure takes a range with no headers. It adds a column with the original sort, sorts the range, deletes the blanks, then resorts the range back to the original way.
Public Sub CompactRows(ByRef rng As Range)
Dim rNew As Range
'Put the row in a column so you can sort it
'back to the original way later
With rng.Offset(, rng.Columns.Count).Resize(, 1)
.Formula = "=ROW()"
.Copy
.PasteSpecial xlPasteValues
End With
'Make a range that includes the sort column
Set rNew = rng.Resize(, rng.Columns.Count + 1)
'Sort on the first column to get all the blanks together
rNew.Sort rNew.Cells(1), xlAscending, , , , , , xlNo
'Assume a blank in column 1 is a blank row - delete them all in one shot
rNew.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Resort the range on the sort column
rNew.Sort rNew.Cells(rNew.Columns.Count), xlAscending, , , , , , xlNo
'Delete the sort column
rNew.Cells(rNew.Columns.Count).EntireColumn.Delete
End Sub
As ExcelHero said, you can sort the rows from Excel. But this will change the order of your non-empty rows. IF you want to remove blank rows but keep the order of your data, you can apply this macro:
Sub removeEmptyRows()
Dim r As Range
For Each r In UsedRange.Rows
If Application.CountA(r) = 0 Then r.Delete
Next
End Sub

Filtering By blanks in VBA

Could anyone give me some insight on how to Filter/Delete Blanks using VBA code? For some reason when I record a Macro to do this it is not allowing some of my custom functions built using VBA to hold their values. Thanks.
The below code will delete out rows that have a blank in a selected column. The code below assumes the second column in your data is being tested for blanks. Let us know if you need additional assistance.
Sub DeleteBlanks()
Dim rDataToProcess As Range
Set rDataToProcess = Sheet1.Range("A1").CurrentRegion
'Field in the below method refers to the column that is being filtered, so the second colum
rDataToProcess.AutoFilter field:=2, Criteria1:=""
rDataToProcess.Offset(1).Resize(rDataToProcess.Rows.Count).EntireRow.Delete
Sheet1.AutoFilterMode = False
End Sub
An alternative to delete cells that are blank is to set a range, and use Range([your range]).SpecialCells(xlCellTypeBlanks).Delete
edit: If you want to delete the entire row, Range([your range]).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Just as #user3561813 said and please take a look at this link for more complicated filters such as multiple criteria, etc:
ActiveSheet.Range("AD1").AutoFilter Field:=30, Criteria1:="", Operator:=xlOr, Criteria2:="XXXX"
For example, the above code filters for both Blanks and "XXXX" fields
Sub Blank_Cells_Filter()
'Apply filters to include or exclude blank cells
Dim lo As ListObject
Dim iCol As Long
'Set reference to the first Table on the sheet
Set lo = Sheet1.ListObjects(1)
'Set filter field
iCol = lo.ListColumns("Product").Index
'Blank cells – set equal to nothing
lo.Range.AutoFilter Field:=iCol, Criteria1:="="
'Non-blank cells – use NOT operator <>
lo.Range.AutoFilter Field:=iCol, Criteria1:="<>"
End Sub

Resources