CODEWITHSUNDEEP
excelfiltervalidation
McShaman
McShaman

Reputation: 3995

Excel filtered data validation list based on cell content

I currently have have a table that looks like this:

  |   A   |     B     |
  +-------+-----------+
1 | State | City      |
  +=======+===========+
2 | NSW   | Goulburn  |
3 | NSW   | Sydney    |
4 | VIC   | Melbourne |
5 | VIC   | Horsham   |
6 | NSW   | Tamworth  |

And then I have another table that looks like this:

  |   A   |     B     |      C     |
  +-------+-----------+------------+
1 | State | City      | Other data |
  +=======+===========+============+
2 |       |           |            |

In this second table I have applied data validation to both the State and City column, referencing the data from the first table. So I have drop down lists of all the states and cities.

What I want to be able to do is, if the user enters "NSW" in the State column, the list of options in the city column are filtered to show only the cities located in NSW

Upvotes: 3

Views: 7138

Answers (1)

David Zemens
David Zemens

Reputation: 53663

Place this in the Worksheet's code module.

Change the definition of shTable to refer to the worksheet on which your lookup table is located.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myVal As String
Dim cityList As String
Dim table As Range
Dim cl As Range
Dim shTable As Worksheet: Set shTable = Sheets("Index") '<modify as needed'

If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub

myVal = Target.Value
With shTable
    Set table = .Range("A2", .Range("A2").End(xlDown)) 'contains your city/state table'
End With
    For Each cl In table
    'Build a comma-separated list of matching cities in the state.'
        If cl.Value = myVal Then
            If cityList = vbNullString Then
                cityList = cl.Offset(0, 1)
            Else:
                If InStr(1, cityList, cl.Offset(0,1).Value, vbBinaryCompare) > 0 Then
                'avoid duplicates, but this is not a foolproof method.'
                'probably should rewrite using an array or scripting dictionary'
                'otherwise the possibility of partial match is a potential error.'
                    cityList = cityList & "," & cl.Offset(0, 1)
                End If
            End If

        End If
    Next

'Now, with the cell next to the changed cell, remove '
' any existing validation, then add new validation '
' based on the cityList we compiled above.
With Target.Offset(0, 1).Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:=cityList
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With

End Sub

Upvotes: 1

Related Questions