VBA, Autofilter method of Range Class Failed, - excel

I am getting the error Autofilter method range of class failed.
I am thinking it is because there is a column space in my headers but not entirely sure as to how to get around this. Getting the error on this line:
ws.Range("$A:$K").AutoFilter field:=10, Criteria1:="#N/A"
I have my range till K, but when it gets to a blank column, ie "I" , the autofilter is only applied till there.
Also if i manually apply a filter to the whole first row the macro works.
Why is this?
Ive tried using A1:K1 and that doesnt work.
When I debug and manually go into apply the filter to the remaining columns the code works fine.

Reference a Discontinuous Range to Apply AutoFilter
All four solutions could (should) work. Your feedback is most welcome.
A rule of thumb: Don't let Excel decide (if you don't have to)... in this case,
to set the range for you.
Sub FilterData()
Dim ws As Worksheet: Set ws = ActiveSheet
If ws.AutoFilterMode Then ws.AutoFilterMode = False
Dim rg As Range
' If your data is the only thing in the worksheet:
Set rg = ws.UsedRange
' ' If there are more columns:
' Set rg = Intersect(ws.UsedRange, ws.Columns("A:K"))
' ' or:
' Dim rg As Range: Set rg = ws.Columns("A:K")
' Dim lCell As Range
' Set lCell = rg.Find("*", , xlFormulas, , xlByRows, xlPrevious)
' Set rg = rg.Resize(lCell.Row)
' ' If additionally there are other data below your data:
' Set rg = ws.Range("A1").CurrentRegion.Resize(, 11) ' K = 11
rg.AutoFilter Field:=10, Criteria1:="#N/A"
End Sub

Related

Dynamically storing a cell reference as a variable in VBA to then select (and delete) a range using the variable stored

I currently have a VBA macro that turns a regular data extract into a table. In the macro I have defined a range which is large enough to exceed the number of rows typically extracted.
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$AG$20000"), , xlYes).Name _
= "Table1"
My macro then does some other transformation/addition of formulas etc to the table, and the table is then presented via PowerBI.
I want to delete the excess rows in the table - which varies for each extract.
In the example below - which has recorded the desired sequence of steps, there are only 186 rows.
Range("Table1[[#Headers],[Client Id]]").Select
Selection.End(xlDown).Select
Range("A187").Select
Range(Selection, Selection.End(xlDown)).Select
Rows("187:20000").Select
Selection.Delete Shift:=xlUp
I want to store the range ("A187") as a variable
I then want to insert the stored variable in the selection 187:20000
Alternatively, if I could do a variabilised selection of the range I want to turn into a table, that would work too.
Any help would be appreciated.
The following will create a table to fit the data assuming there are no extra data cells:
ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlYes).Name = "Table1"
If you need to force columns to include "A:AG" only use:
ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion.Columns("A:AG"), , xlYes).Name = "Table1"
ActiveSheet.ListObjects.Add(...).Name = "Table1" is how a recorded macro would create the table. To avoid naming conflict, I would avoid using the generic Table1 as a name.
If the name isn't important use:
ActiveSheet.ListObjects.Add xlSrcRange, Range("A1").CurrentRegion.Columns("A:AG"), , xlYes
If there is only one Table on the woksheet, you can refer to it as:
ActiveSheet.ListObjects(1)
Delete Empty Bottom Rows (Applied to an Excel Table (ListObject))
Sub DeleteEmptyBottomRowsTEST()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
Dim tbl As ListObject: Set tbl = ws.ListObjects("Table1")
' Remove possible filters.
' The Find method will fail if the table is filtered.
If tbl.ShowAutoFilter Then
If tbl.AutoFilter.FilterMode Then tbl.AutoFilter.ShowAllData
End If
Dim rg As Range: Set rg = tbl.DataBodyRange
If rg Is Nothing Then Exit Sub
DeleteEmptyBottomRows rg
End Sub
Sub DeleteEmptyBottomRows(ByVal rg As Range)
Dim lCell As Range
Set lCell = rg.Find("*", , xlFormulas, , xlByRows, xlPrevious)
If lCell Is Nothing Then rg.Delete xlShiftUp: Exit Sub
Dim rOffset As Long: rOffset = lCell.Row - rg.Row + 1
Dim rCount As Long: rCount = rg.Rows.Count
If rOffset = rCount Then Exit Sub
Dim rResize As Long: rResize = rCount - rOffset
rg.Resize(rResize).Offset(rOffset).Delete xlShiftUp
End Sub

VBA cannot AutoFilter a Range for a certain criteria

I am trying to make a Range object of all entrys and than apply a filter, which searches for a number in there.
I want the Range to hold only the matching entrys afterwards, but I always get the error 1004...
Here the code:
Dim rSearch As Range
Dim rResult As Range
Set rSearch = wbMe.Sheets(iCurSheet).Range("F2:F1000")
rSearch.AutoFilter Field:=iColKey, Criteria1:="=" & wbMe.Sheets(iCurSheet).Cells(iLine, iColKey).Value
The last line throws the exception. I found out that the AutoFilter has to be applied to the first line, so .Range("A1:K1"), but I still don't get why I am not able to Filter on a Range, maybe i get the Object wrong?
Thanks in advance!
Edit:
So I tried some stuff:
Set rSearch = wbMe.Sheets(iCurSheet).Range("A2:K1000")
rSearch.AutoFilter Field:=11, Criteria1:="=" & wbMe.Sheets(iCurSheet).Cells(iLine, iColKey).Value
MsgBox "Count Rows rSearch:" & rSearch.Rows.Count
I expected the MsgBox to say smth less, but I get 999, so it hasn't filtered anything.
My guess that I was filtering the wrong column, but I wanna filter on Col K (I need Col F afterwards to search once more, sry for mixing stuff up).
Now I don't get the AutoFilter exception anymore. But for some reason my rSearch range does not shrink.
How do I shrink my Range?
Count Visible Data Cells (Criteria Cells)
A quick fix could be something like
MsgBox "Count Rows rSearch:" & rSearch.Columns(11).SpecialCells(xlCellTypeVisible).Cells.Count - 1
Note that the headers need to be included in the range for AutoFilter to work correctly.
Using SpecialCells
Sub CountVisibleDataCells()
' Define constants.
Const CriteriaIndex As Long = 11
' Reference the workbook ('wb').
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Reference the worksheet ('ws').
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
' Turn off AutoFilter.
If ws.AutoFilterMode Then ws.AutoFilterMode = False
' Reference the range ('rg').
Dim rg As Range: Set rg = ws.Range("A1:K21")
' Store the criteria value from the cell, converted to a string ('CStr'),
' in a string variable ('Criteria'). AutoFilter 'prefers' this.
Dim Criteria As String: Criteria = CStr(ws.Range("M1").Value)
' Filter the range.
rg.AutoFilter Field:=CriteriaIndex, Criteria1:=Criteria
' Reference the visible cells in the criteria column ('vrg').
Dim vrg As Range
Set vrg = rg.Columns(CriteriaIndex).SpecialCells(xlCellTypeVisible)
' Turn off the worksheet auto filter.
ws.AutoFilterMode = False
' Store the number of visible cells of the criteria column
' in a long variable (subtract 1 to not count the header).
Dim CriteriaCount As Long: CriteriaCount = vrg.Cells.Count - 1
' Inform.
MsgBox "Count of '" & Criteria & "': " & CriteriaCount
End Sub
Using Application Count
Sub CountCriteriaCells()
' Define constants.
Const CriteriaIndex As Long = 11
' Reference the workbook ('wb').
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Reference the worksheet ('ws').
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
' Turn off AutoFilter.
If ws.AutoFilterMode Then ws.AutoFilterMode = False
' Reference the range ('rg').
Dim rg As Range: Set rg = ws.Range("A1:K21")
' Store the criteria value from the cell, converted to a string ('CStr'),
' in a string variable ('Criteria').
Dim Criteria As String: Criteria = CStr(ws.Range("M1").Value)
' You may need to modify this because 'CountIf' works differently.
' Reference the criteria data range ('cdrg') (no headers).
Dim cdrg As Range
With rg.Columns(CriteriaIndex)
Set cdrg = .Resize(.Rows.Count - 1).Offset(1)
End With
' Store the number of cells containing the criteria ('CriteriaCount')
' in a long variable.
Dim CriteriaCount As Long
CriteriaCount = Application.CountIf(cdrg, Criteria)
' Inform.
MsgBox "Count of '" & Criteria & "': " & CriteriaCount
End Sub

Delete cells in column after last row in another

I would like to clear content of cells (not delete rows) in a column after the last row of another column. The code would act as follows to work properly
Go to last cell in column BA,
move to the right to column BB
delete all rows in BB below that last rows
When I try recording the macro the code includes the range of that last cell as a fixed place.
This is the code, I highlighted where I believe the issue is
Sub CopyPaste2()
'
' CopyPaste2 Macro
'
'
Columns("AS:AV").Select
Selection.Copy
Columns("AX:AX").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
**Range("BA7").Select
Selection.End(xlDown).Select
Range("BB47").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.ClearContents**
Range("BB46").Select
Selection.End(xlUp).Select
Range("BB7").Select
Selection.AutoFill Destination:=Range("BB7:BB46")
Range("BB7:BB46").Select
Range("BA6").Select
ActiveWorkbook.Worksheets("KPI - Efficiency - Case Level").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("KPI - Efficiency - Case Level").Sort.SortFields.Add _
Key:=Range("BA7:BA46"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("KPI - Efficiency - Case Level").Sort
.SetRange Range("AX6:BB46")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Im pretty new to VBA so really appreciate your help
Try this:
Add the following line near the top of your code - traditionally, we tend to declare our variables at the start of a procedure:
'declare 'lastrow' to store value of row number
Dim lastrow As Long
And then at the end of your code, after the sort etc., add this:
With ActiveWorkbook.Worksheets("KPI - Efficiency - Case Level")
' find last used row of column BA and add 1
lastrow = .Range("BA" & .Rows.Count).End(xlUp).Row + 1
' clear from 'lastrow' to bottom of sheet in column BB
.Range("BB" & lastrow & ":BB" & .Rows.Count).ClearContents
End With
I can see you've recorded this macro, so it's a little messy. If you're interested in learning how to craft better vba that is more portable and easier to read, you will want to read up on avoiding Select etc.:
How to avoid using Select in Excel VBA
Clear the Cells Below a Range
If rg is a range object, to clear all cells below it, you can use the following line:
rg.Resize(rg.Worksheet.Rows.Count - rg.Row - rg.Rows.Count + 1).Offset(rg.Rows.Count).Clear
In the code, some parts of it are replaced with variables:
drg.Resize(ws.Rows.Count - FirstRow - rCount + 1).Offset(rCount).Clear
If rg has only one row, you can simplify with:
rg.Resize(rg.Worksheet.Rows.Count - rg.Row).Offset(1).Clear
Clear Below
Sub ClearBelow()
' Reference the workbook ('wb').
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Reference the worksheet ('ws').
Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
Dim lCell As Range
' ("Go to last cell in column BA")
' Reference the last non-empty cell in column 'BA' using 'End'
' (in the code the Find method is used instead of the End property).
Set lCell = ws.Cells(ws.Rows.Count, "BA").End(xlUp)
' ("Move to the right to column BB")
' Reference the cell adjacent to the right using offset.
Set lCell = lCell.Offset(, 1)
' Reference the cell in the same row but in column 'BB' using 'EntireRow'.
' (can be any column).
'Set lCell = lCell.EntireRow.Columns("BB")
' ("Delete all rows in BB below that last rows")
' Clear all cells below the cell using 'Resize' and 'Offset'.
lCell.Resize(ws.Rows.Count - lCell.Row).Offset(1).Clear
End Sub
The Code
Option Explicit
Sub CopyPaste2() ' be more creative e.g. 'CreateEfficiencyReport'!
' Define constants.
Const wsName As String = "KPI - Efficiency - Case Level"
Const sColumnsString As String = "AS:AV" ' Source Copy Columns
Const dFirstColumnString As String = "AX" ' Destination First Copy Column
Const FirstRow As Long = 7
' Reference the workbook ('wb').
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Reference the worksheet ('ws').
Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
' To make sure that the worksheet is not filtered, when the remaining
' code would fail, you could use the following:
'If ws.FilterMode Then ws.ShowAllData
' Reference the source columns range ('scrg') ('$AS$7:$AV$1048576').
Dim scrg As Range: Set scrg = ws.Rows(FirstRow).Columns(sColumnsString) _
.Resize(ws.Rows.Count - FirstRow + 1)
'Debug.Print scrg.Address(0, 0)
' Attempt to reference the last cell ('lCell'), the bottom-most
' non-empty cell in the source columns range (for the bottom-most
' non-blank cell, use 'xlValues' instead of 'xlFormulas').
Dim lCell As Range
Set lCell = scrg.Find("*", , xlFormulas, , xlByRows, xlPrevious)
If lCell Is Nothing Then Exit Sub ' no data
'Debug.Print lCell.Address(0, 0)
' Reference the source range ('srg').
Dim srg As Range: Set srg = scrg.Resize(lCell.Row - FirstRow + 1)
'Debug.Print srg.Address(0, 0)
' Write the number of rows and columns of the source range
' to variables ('rCount', 'cCount').
Dim rCount As Long: rCount = srg.Rows.Count
Dim cCount As Long: cCount = srg.Columns.Count
Dim dcrg As Range ' Destination Copy Range
Dim dfcCell As Range ' Destination First Copy Cell
' Reference the destination first copy cell ('dfcCell').
Set dfcCell = ws.Cells(FirstRow, dFirstColumnString)
' Reference the destination copy range ('dcrg').
Set dcrg = dfcCell.Resize(rCount, cCount)
'Debug.Print dcrg.Address(0, 0)
' Copy the values from the source range to the destination copy range.
dcrg.Value = srg.Value
Dim dfrg As Range ' Destination Formula Range
Dim dffCell As Range ' Destination First Formula Cell
' Reference the destination first formula cell ('dffCell')
' in the column adjacent to the right of the copy range.
Set dffCell = dfcCell.Offset(, cCount)
' Reference the destination formula range ('dfrg').
Set dfrg = dffCell.Resize(rCount)
'Debug.Print dfrg.Address(0, 0)
Dim drg As Range ' (Whole) Destination Range
If rCount > 1 Then
' Write the formula from the first formula cell to the remaining cells
' of the destination formula range.
dfrg.Formula = dffCell.Formula
'
' Reference the destination range ('drg').
Set drg = dcrg.Resize(, cCount + 1) ' include the formula column
'Debug.Print drg.Address(0, 0)
' Sort the destination range ('drg') by the last column
' of the copy range.
drg.Sort drg.Columns(cCount), xlAscending, , , , , , xlNo
'Else ' there is only one row of data; do nothing
End If
' Clear the cells below the destination range.
drg.Resize(ws.Rows.Count - FirstRow - rCount + 1).Offset(rCount).Clear
End Sub

How to select entire column except header

I am using below code.
Sub Replace_specific_value()
'declare variables
Dim ws As Worksheet
Dim xcell As Range
Dim Rng As Range
Dim newvalue As Long
Set ws = ActiveSheet
Set Rng = ws.Range("G2:G84449")
'check each cell in a specific range if the criteria is matching and replace it
For Each xcell In Rng
xcell = xcell.Value / 1024 / 1024 / 1024
Next xcell
End Sub
Here i don't want to specify G2:G84449 , how do i tell VBA to pick all value instead of specifying range?
Watch: Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset)
Here is the standard way to get the used cell in column G starting at G2:
With ws
Set Rng = .Range("G2", .Cells(.Rows.Count, "G").End(xlUp))
End With
If the last row could be hidden use:
With ws
Set Rng = Intersect(.Range("A1", .UsedRange).Columns("G").Offset(1), .UsedRange)
End With
If Not Rng Is Nothing Then
'Do Something
End If
Reference Column Data Range (w/o Headers)
If you know that the table data starts in the first row of column G, by using the Find method, you can use something like the following (of course you can use the more explicit
With ws.Range("G2:G" & ws.Rows.Count) instead, in the first With statement).
Option Explicit
Sub BytesToGigaBytes()
Const Col As String = "G"
Dim ws As Worksheet: Set ws = ActiveSheet 'improve!
With ws.Columns(Col).Resize(ws.Rows.Count - 1).Offset(1) ' "G2:G1048576"
Dim lCell As Range: Set lCell = .Find("*", , xlFormulas, , , xlPrevious)
If lCell Is Nothing Then Exit Sub ' empty column
With .Resize(lCell.Row - .Row + 1) ' "G2:Glr"
.Value = ws.Evaluate("IFERROR(IF(ISBLANK(" & .Address & "),""""," _
& .Address & "/1024/1024/1024),"""")")
End With
End With
End Sub
Here's a slightly different approach that works for getting multiple columns, as long as your data ends on the same row:
set rng = application.Intersect(activesheet.usedrange, activesheet.usedrange.offset(1), range("G:G"))
This takes the intersection of the used range (the smallest rectangle that holds all data on the sheet, with the used range offset by one row (to exclude the header), with the columns you are interested in.

Fill in the entire column according to the last data in the table - Does not work

I have a formula in Column A2.
I have a table similar to this:
Formula
Note
Datum
I am very happy because I am
Years
years old
=CONCATENATE(TEXT(C2;"dd-mm-yyyy");$D$1;E2;$F$1)
Any word, TEXT
01.04.2021
21
Autofill
Any word, TEXT 2
01.04.2021
25
I want to transfer it and use it automatically for the whole column. However, I tried possible and impossible ways to do it, but none of them worked. I also looked at forums such as here:
I don't have all the data filled in the table, so I want "excel" to look for the last row in which the record is and try to calculate the formula and return it to the last cell in column A.
Thank you in advance for all the help
(The formula joins the text together) =CONCATENATE(TEXT(C2;"dd-mm-yyyy");$D$1;E2;$F$1)
Sub AutofilCol()
' Apply to the entire column Autofill
Range("A1").Offset(1, 0).Activate
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(TEXT(RC[2],""dd-mm-yyyy""),R1C4,RC[4],R1C6)"
' AutoFill
Selection.AutoFill Destination:=Range("A2:A").End(xlDown).Row
ActiveCell.EntireColumn.AutoFit
End Sub
It looks like this is what you want to do:-
Sub AutofillCol()
Dim Rl As Long ' last used row in column C
Dim Rng As Range
Rl = Cells(Rows.Count, "C").End(xlUp).Row
Set Rng = Range(Cells(2, "A"), Cells(Rl, "A"))
Rng.FormulaR1C1 = "=CONCATENATE(TEXT(RC[2],""dd-mm-yyyy""),R1C4,RC[4],R1C6)"
End Sub
Copy Formulas (Defining a Range)
In this case, there is no need to Activate (or Select) anything neither is the use of AutoFill (FillDown).
Let's say the first solution is the most flexible (reliable) but also the most complex. To better understand it, see the ranges at the various stages of the code printed in the Immediate window (CTRL+G). The flexibility is in the option to use any first cell address e.g. C5, D10, etc. and it will still work.
Depending on your data, you might easily get away with the remaining two solutions.
I didn't include any solution using End since you got that covered by another post.
Option Explicit
Sub copyFormulas()
Const First As String = "A1"
Dim ws As Worksheet: Set ws = ActiveSheet
Dim fCell As Range ' Last Cell in First Row Range
Dim frg As Range ' First Row Range of Table Range
With ws.Range(First)
Set fCell = .Resize(, .Worksheet.Columns.Count - .Column + 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If fCell Is Nothing Then Exit Sub
Set frg = .Resize(, fCell.Column - .Column + 1)
Debug.Print "First", fCell.Address, frg.Address
End With
Dim tCell As Range ' Last Cell in Table Range
Dim trg As Range ' Table Range
With frg
Set tCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
.Find("*", , xlFormulas, , xlByRows, xlPrevious)
Set trg = .Resize(tCell.Row - .Row + 1)
End With
Debug.Print "Table", tCell.Address, trg.Address
Dim drg As Range ' Destination Range
Set drg = trg.Columns(1).Resize(trg.Rows.Count - 1).Offset(1)
Debug.Print "Destination", drg.Address
drg.FormulaR1C1 = "=CONCATENATE(TEXT(RC[2],""dd-mm-yyyy""),R1C4,RC[4],R1C6)"
' Or.
'drg.Formula = "=CONCATENATE(TEXT(C2,""dd-mm-yyyy""),$D$1,E2,$F$1)"
End Sub
Sub copyFormulasUsedRange()
With ActiveSheet.UsedRange.Columns(1)
.Resize(.Rows.Count - 1).Offset(1).FormulaR1C1 _
= "=CONCATENATE(TEXT(RC[2],""dd-mm-yyyy""),R1C4,RC[4],R1C6)"
End With
End Sub
Sub copyFormulasCurrentRegion()
With ActiveSheet.Range("A1").CurrentRegion.Columns(1)
.Resize(.Rows.Count - 1).Offset(1).FormulaR1C1 _
= "=CONCATENATE(TEXT(RC[2],""dd-mm-yyyy""),R1C4,RC[4],R1C6)"
End With
End Sub

Resources