Filter a range that the value of my cell number falls into

[Jimmy509]

Hi,
I am working with 2 worksheet in the same workbook. Sheet1 has the values. Sheet 2 has the table of data with header.
My goal is to read the values from sheet1 and then filter a specific column with that said value. I can get that far. The issue is my value in sheet1 is not an exact value of what would be in sheet2.
for example. In sheet1 I have values of a = 5.68. Now when I go in sheet2 it does not have 5.68 in the "a" column but I want to select and filter the values that a =5.68 falls into. for example sheet2 may have 4.5 and 7.5. if those are the values closest/nearest to the a values then I want to filter them. In summary if a = 5.68 in sheet 2, then I go in sheet2 and filter the range that 5.68 falls into and those values would be 4.5 and 7.5 and take the resulting value in the next column and paste it in a new sheet.
Here's what I started with:

Sub Filter_criteria()
Dim A As String

With Worksheets("Sheet1")

Set Al = .Range("A11")

End With

With Worksheets("Sheet2")
With .Range("A1:N" & Cells(.Rows.Count, "N").End(xlUp).Row)
.AutoFilter
Range("K1").AutoFilter Field:=11, Criteria1:=lat, Operator:=xlFilterValues

End With
.AutoFilterMode = False
End With
End Sub

 

[Jimmy509]

Ok, no worries. Thanks for trying

 

[jasonb75]

Had a bit of time spare this morning, came up with this as a ] theoretical method but not enough time to set anything up to test it. It might work, it might do nothing.
This is only meant to test filtering, nothing there to copy results to another sheet yet.

Option Explicit
Sub test()
Dim sVal As Double, lRow As Long, sFound As Range, lRng As Range, uRng As Range, c As Range, fCol As Long
With Worksheets("Sheet2")
        lRow = .Cells(Rows.Count, 14).End(xlUp).Row
        For fCol = 1 To 3
        sVal = Worksheets("Sheet1").Range("A11:A13")(fCol).Value
        With .Range("A1:N" & lRow)
            .AutoFilter
                Set sFound = .Columns(10 + fCol).SpecialCells(xlVisible).Find(sVal, , xlValues, xlWhole, , False, False, False)
            If Not sFound Is Nothing Then
                .AutoFilter Field:=(10 + fCol), Criteria1:=sFound.Value
                Set sFound = Nothing
            Else
                For Each c In .Columns(10 + fCol).SpecialCells(xlVisible).Cells
                    If c.Value > sVal Then
                        If uRng Is Nothing Then
                            Set uRng = c
                        Else
                            If c.Value < uRng.Value Then Set uRng = c
                        End If
                    Else
                        If lRng Is Nothing Then
                            Set lRng = c
                        Else
                            If c.Value > lRng.Value Then Set lRng = c
                        End If
                    End If
                    .AutoFilter Field:=11, Criteria1:=lRng.Value, Operator:=xlOr, Criteria2:=uRng.Value
                    Set uRng = Nothing
                    Set lRng = Nothing
                Next
            End If
        End With
    Next fCol
End With
End Sub

 

[Jimmy509]

ok no worries. I'll be on the look out for an update

 

[Jimmy509]

I think the code crash at this line
.AutoFilter Field:=11, Criteria1:=lRng.Value, Operator:=xlOr, Criteria2:=uRng.Value

 

[jasonb75]

This is working now, but I'm not sure that it will give you exactly what you want.

Unless there is an exact match for all 3 criteria, A11 in column K, A12 in column L and A13 in column M the results will vary depending on which column is filtered first.

I've added a copy line to the end, you just need to choose where to paste.

Option Explicit
Sub test()
Dim sVal As Double, lRow As Long, sFound As Range, lRng As Range, uRng As Range, c As Range, fCol As Long
With Worksheets("Sheet2")
        lRow = .Cells(Rows.Count, 14).End(xlUp).Row
        For fCol = 1 To 3
        sVal = Worksheets("Sheet1").Range("A11:A13")(fCol).Value
        With .Range("A1:N" & lRow)
                Set sFound = .Columns(10 + fCol).SpecialCells(xlVisible).Find(sVal, , xlValues, xlWhole, , False, False, False)
            If Not sFound Is Nothing Then
                .AutoFilter Field:=(10 + fCol), Criteria1:=sFound.Value
                Set sFound = Nothing
            Else
                For Each c In .Columns(10 + fCol).Offset(1).Resize(lRow - 1, 1).SpecialCells(xlVisible).Cells
                    If c.Value > sVal Then
                        If uRng Is Nothing Then
                            Set uRng = c
                        Else
                            If c.Value < uRng.Value Then Set uRng = c
                        End If
                    Else
                        If lRng Is Nothing Then
                            Set lRng = c
                        Else
                            If c.Value > lRng.Value Then Set lRng = c
                        End If
                    End If
                Next
                If lRng Is Nothing Then
                    .AutoFilter Field:=(10 + fCol), Criteria1:=uRng.Value
                ElseIf uRng Is Nothing Then
                    .AutoFilter Field:=(10 + fCol), Criteria1:=lRng.Value
                Else
                    .AutoFilter Field:=(10 + fCol), Criteria1:=lRng.Value, Operator:=xlOr, Criteria2:=uRng.Value
                End If
                Set uRng = Nothing
                Set lRng = Nothing
            End If
        End With
    Next fCol
    .Range("N2:N" & lRow).SpecialCells(xlVisible).Copy
End With
End Sub

 

[Jimmy509]

Thanks for the reply

 

[Jimmy509]

I wonder how different the code would be if sval value was on a different rows. Let's say A11 is in D11, A12 is D90 and A13 is D199

 

[jasonb75]

Not much different, only one line to change.

sVal = Worksheets("Sheet1").Range("D11,D90,D199").Areas(fCol).Value