Home > Enterprise >  VLOOKUP Macro for AutoFiltered data
VLOOKUP Macro for AutoFiltered data

Time:02-24

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 column A.
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 unfiltered table

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":

enter image description here

  • Related