I'm still learning VBA and am wondering if there's a way to run a VLOOKUP in a filtered range.
For example, in the code below, after I filter the data, the first row with data is A4.
However, I have to manually specify that the first row of data is in A4.
My question is whether it's possible so the macro detects the first row of data itself instead of me having to specify.
I've read about potentially using SpecialCells.
I am trying to do this as the datasets I receive change daily, so the first filtered row being A4 today might be A15 or whatever tomorrow.
Thanks
Range("A4").Select '/have to specify range here
Dim formul As String
formul = "=VLOOKUP(C2,Sheet2!A:B,2,0)"
Range("A4:A" & Cells(Rows.Count, 1).End(xlUp).Row) = [formul] '/also specify range here
'''
edit: code with SpecialCells: ''' vba
Range("A1").Select '/have to specify range here
Dim formul As String
formul = "=VLOOKUP(C1,Sheet2!A:B,2,0)"
Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible) = [formul] '/also specify range here
'''
CodePudding user response:
Formula To Filtered Cells
- This will filter column
C
and write formulas to the filtered cells in columnA
.
Option Explicit
Sub FormulaToFilteredCells()
Const sName As String = "Sheet2"
Const dName As String = "Sheet1"
Const dLookupColumn As Long = 1
Const dCriteriaColumn As Long = 3
Const dCriteria As String = "Yes"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
If dws.FilterMode Then dws.ShowAllData ' remove previous filter
Dim drg As Range ' Destination Table Range (has headers)
Set drg = dws.Range("A1").CurrentRegion.Columns(dCriteriaColumn)
Dim ddrg As Range ' Destination Data Range (no headers)
Set ddrg = drg.Resize(drg.Rows.Count - 1).Offset(1)
Dim dcOffset As Long: dcOffset = dLookupColumn - dCriteriaColumn
drg.AutoFilter 1, dCriteria
Dim dvdrg As Range ' Destination Visible Data Range
On Error Resume Next
Set dvdrg = ddrg.SpecialCells(xlCellTypeVisible).Offset(, dcOffset)
On Error GoTo 0
dws.AutoFilterMode = False
If dvdrg Is Nothing Then Exit Sub ' no filtered cells
dvdrg.Formula = "=VLOOKUP(" & dvdrg.Cells(1).Offset(, -dcOffset) _
.Address(0, 0) & ",'" & dName & "'!A:B,2,0)"
End Sub
CodePudding user response:
Working with filtered data is possible with array formulas as shown
Sub FilterTable_and_Copy()
'Prepare Sheet2
If Sheets(2).Name <> "Filtered Data" Then
Sheets.Add After:=Sheets(1)
Sheets(2).Name = "Filtered Data"
End If
Sheets(2).Columns("A:G").ClearContents
'The Data is prepared in the Table "myTable"
'ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$F$100"), , _
' xlYes).Name = "myTable"
'Filter Data
Sheets(1).Select
ActiveSheet.Range("myTable").AutoFilter Field:=2, Criteria1:="Asia"
'Copy Filtered Data to Sheet2
Range("myTable").Copy
Sheets(2).Select
Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Copy Header
Sheets(1).Select
Rows("1:1").Copy
Sheets(2).Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Format Columns Width
Columns("A:F").ColumnWidth = 30
Columns("A:F").EntireColumn.AutoFit
Range("G1").Select
'Create Table "Table_FilteredData"
Sheets(2).ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , _
xlYes).Name = "Table_FilteredData"
'Correct Formatting Issue
Dim myRange As Range
With Sheets(2).ListObjects("Table_FilteredData")
Set myRange = .Range
.Unlist
End With
With myRange
.Interior.ColorIndex = xlColorIndexNone
.Font.ColorIndex = xlColorIndexAutomatic
.Borders.LineStyle = xlLineStyleNone
End With
Sheets(2).ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , _
xlYes).Name = "Table_FilteredData"
Sheets(2).ListObjects(1).TableStyle = "TableStyleMedium3"
End Sub
Data filtered for "region = Asia":