Filter based on two columns

[amir0914]

Hi all,
There are lots of data in several columns of my excel file. I want to filter the data with criteria by column "D" that is greater than column "A", for sample :
Screenshot (1605).jpg

And I need to do this with vba, can someone give a solution? (without copy or move data to another location)
Thanks in advanced.

[BIFanatic]

Try this:

Option Explicit


Sub FilterData()
    
    Dim OriginalData() As Variant
    Dim DataRange As Range
    Dim ws As Worksheet
    Dim x As Long, y As Long
    Dim FilteredData() As Variant
    Dim Counter As Long
    
    Set ws = Sheet1 ' change this to your sheet's codename or better just use that code name in the next step
    Set DataRange = ws.Range("A2", ws.Range("A1").End(xlDown).End(xlToRight))
    
    OriginalData = DataRange
    
    Counter = 1
    
    For x = 1 To UBound(OriginalData, 1)
        If OriginalData(x, 1) < OriginalData(x, 4) Then
            
            ReDim Preserve FilteredData(1 To UBound(OriginalData, 2), 1 To Counter)
            
            For y = 1 To UBound(FilteredData, 1)
                FilteredData(y, Counter) = OriginalData(x, y)
            Next y
            
            Counter = Counter + 1
        End If
    Next x
    
    ws.Range("G2").Resize(UBound(FilteredData, 2), UBound(FilteredData, 1)).Value = TransposeArray(FilteredData())
    
End Sub


Private Function TransposeArray(v() As Variant) As Variant
    
    Dim Dummy() As Variant
    Dim x As Long, y As Long
    
    ReDim Dummy(1 To UBound(v, 2), 1 To UBound(v, 1))
    
    For x = 1 To UBound(v, 2)
        For y = 1 To UBound(v, 1)
            Dummy(x, y) = v(y, x)
        Next y
    Next x
    
    TransposeArray = Dummy()
    
End Function

[p45cal]

without copy or move data to another location

On Sheet4 of the attached is a macro solution. It briefly uses cells F1:F2 as criteria for an advanced filter:

Sub blah()
Range("F1").ClearContents
Range("F2").FormulaR1C1 = "=RC4>RC1"
Range("A1").CurrentRegion.Resize(, 4).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("F1:F2")
Range("F2").ClearContents
End Sub

On Sheet3 there's another solution which does update a result table in another location. Update the source data table on the left, then right-click the result table and choose Refresh.

It really is a good idea to attach your own sample file - you'll get answers more quickly.