Filtering data on multiple conditions

[Aussiebear]

Is it possible to filter GPS data in two columns using a max & min value for each column?

[Paul_Hossler]

I don't know about GPS data, but you can filter between numbers on 2 columns (min / max)

Sub Macro1()
    Rows("1:1").AutoFilter
    ActiveSheet.Range("$A$1:$B$15").AutoFilter Field:=1, Criteria1:=">=3", Operator:=xlAnd, Criteria2:="<=8"
    ActiveSheet.Range("$A$1:$B$15").AutoFilter Field:=2, Criteria1:=">=7", Operator:=xlAnd, Criteria2:="<=9"
    Selection.AutoFilter
End Sub

[Aussiebear]

Paul, when I run your macro it simply flashes and returns to the original data. Excel will treat the GPS data as a number when I convert to decimal degrees.

This comes about because I'm having great difficulty with the test if point lies within a polygon script that you helped develop. Currently errors occur with a GPS location is being allocated to two or more polygons, so I am forced into manually locating each GPS point. Since I have several polygons using a similar boundry I was hoping to filter the data and then only having look at the differences to determine which polygon the point lies in.

[Paul_Hossler]

The

Selection.Autofilter

turns off filtering

Delete it or single step through in the attachment and you'll end up with this

Capture.JPG


All of col A are between 3-8 and all of col B are between 7-9

I didn't have any GPS data lying around to test so I just used integers

[Aussiebear]

Thank you Paul

[Paul_Hossler]

[Aussiebear]

Not at all sure if I'm on the right track here:

Since I need to pick the criteria to filter the data from, I was thinking of using an InputBox to allocate the 4 criteria,
Column C holds the GPS East decimal degree values, Column D holds GPS South decimal degree values,

Sub AdvancedFilter()
Dim A as String
Dim B() AS String
Dim E1 As Double
Dim E2 As Double
Dim S1 As Double
Dim S2 As Double
A= InputBox("Enter Criteria As E1,E2,S1,S2" ([E1]-[E2]-[S1]-[S2]) 'take input from User
B= Split(A, "-')
E1= B(0)
E2= B(1)
S1= B(3)
S2= B(4)
Columns ("A:D").AutoFilter ' Change to suit full data range
ActiveSheet Range ("$C$2:$C$1300"). AutoFilter Field:=1, Criteria1:= ">=" & E1, _
Operator:= xlAnd, Criteria2:= "<=" & E2
ActiveSheet Range ($D$2:$D$1300").AutoFilter Field:= 2, Criteria1:= ">=" & S1, _
Operator:= xlAnd, Criteria2:= "<=" & S2
End Sub

Am I heading in the right direction?

[Paul_Hossler]

Personally, I prefer not to use InputBoxs for things / values that might be persistant. I'd use a worksheet form just to keep it simple. Of course a user form would be prettier but is probably overkill

Capture.JPG


This uses a command button to run the macro, but you could hook into the Worksheet_Change event and update whenever the 4 input cells changed

Option Explicit
Const minEast As Double = 100#
Const maxEast As Double = 180#
Const minSouth As Double = 10#
Const maxSouth As Double = 80#
Const modTitle As String = "Lat/Long Filter"

Sub FilterLatLongs()
    Dim rLatLong As Range
    Dim E1 As Variant, S1 As Variant, E2 As Variant, S2 As Variant
    Dim vTemp As Double
    
    With ActiveSheet
        E1 = .Range("A3").Value
        S1 = .Range("B3").Value
        E2 = .Range("A5").Value
        S2 = .Range("B5").Value
    
        If Not pvtCheckInputOK("East 1", minEast, maxEast, E1) Then Exit Sub
        If Not pvtCheckInputOK("East 2", minEast, maxEast, E2) Then Exit Sub
        If Not pvtCheckInputOK("South 1", minSouth, maxSouth, S1) Then Exit Sub
        If Not pvtCheckInputOK("South 2", minSouth, maxSouth, S2) Then Exit Sub
        
        Application.ScreenUpdating = False
        
        'E1 must be < E2 and S1 must be < S2
        If E1 > E2 Then
            vTemp = E2
            E2 = E1
            E1 = vTemp
        End If
        If S1 > S2 Then
            vTemp = S2
            S2 = S1
            S1 = vTemp
        End If
    
        Set rLatLong = Range(.Range("A6"), .Range("A6").End(xlDown)).Resize(, 2)
    
        If .FilterMode = False Then
            rLatLong.Rows(1).AutoFilter
        End If
    
    End With
    
        rLatLong.AutoFilter Field:=1, Criteria1:=">=" & CDbl(E1), Operator:=xlAnd, Criteria2:="<=" & CDbl(E2)
        rLatLong.AutoFilter Field:=2, Criteria1:=">=" & CDbl(S1), Operator:=xlAnd, Criteria2:="<=" & CDbl(S2)
NiceExit:
    Application.ScreenUpdating = True
End Sub

Private Function pvtCheckInputOK(sDescrip As String, minVal As Double, maxVal As Double, theVal As Variant) As Boolean
        
        pvtCheckInputOK = False
        
        If Not IsNumeric(theVal) Then
            Call MsgBox("Point " & sDescrip & " must be a number", vbCritical + vbOKOnly, modTitle)
            Exit Function
        End If
        If Len(theVal) = 0 Then
            Call MsgBox("Point " & sDescrip & " cannot be blank", vbCritical + vbOKOnly, modTitle)
            Exit Function
        End If
        If Not (theVal >= minVal And theVal <= maxVal) Then
            Call MsgBox("Point " & sDescrip & " must be between " & minVal & " and " & maxVal, vbCritical + vbOKOnly, modTitle)
            Exit Function
        End If
        pvtCheckInputOK = True
End Function

[Aussiebear]

Once again thank you for your assistance in this issue.

[Paul_Hossler]

A lot of personal (mine) opinion and preferences, but might give you some ideas

[Aussiebear]

I've travelled 300 klms just to stuff this up. In the attached workbook, the autofilter fails on the following line;

"rLatLong.AutoFilter Field:=3, Criteria1:=">=" & CDbl(S1), Operator:=xlAnd, Criteria2:="<=" & CDbl(S2)", and I'm guessing it will also fail on the following line as well. All that I changed here was the Field:=1 to Field:=3, as the column to be filtered is Column C containing the (South) decimal degrees.

[Paul_Hossler]

Since rLatLong.Address = $C$7:$D$1085, you need to use the column numbers based on the range, and not the worksheet


Give this a shot

        rLatLong.AutoFilter Field:=1, Criteria1:=">=" & CDbl(S1), Operator:=xlAnd, Criteria2:="<=" & CDbl(S2)
        rLatLong.AutoFilter Field:=2, Criteria1:=">=" & CDbl(E1), Operator:=xlAnd, Criteria2:="<=" & CDbl(E2)

[Aussiebear]

Righto... I'll go stand in the corner for a while then.