Solved: Lookup County

[av8tordude]

Can someone assist with a VBA code that will lookup the county for each city and enter it into column C. If the city is not listed, enter [Other] as the county.

Thanks for your assistance.

[GTO]

Hi Aviator,

Not well tested and 'fuzzy matches' are beyond me, but see if this is in the right direction.

Option Explicit
    
Sub FindCounty()
Dim rngWheredYouSayThisIs As Range
Dim rngCities As Range
Dim rngFound As Range
Dim Cell As Range
Dim FirstAddress As String
Dim bolFound As Boolean
    
    With Sheet1
        Set rngWheredYouSayThisIs = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
        Set rngCities = Range(.Cells(2, 6), .Cells(.Rows.Count, 6).End(xlUp))
        
        For Each Cell In rngWheredYouSayThisIs
            If Not IsError(Application.Match(Cell.Value, rngCities, 0)) Then
                If Not Application.CountIf(rngCities, Cell.Value) > 1 Then
                    Cell.Offset(, 2).Value = RangeFound(rngCities, Cell.Value, , , xlWhole).Offset(, 1).Value
                Else
                    Set rngFound = RangeFound(rngCities, Cell.Value, , , xlWhole)
                    If Not rngFound.Offset(, -1).Value = Cell.Offset(, 1).Value Then
                        bolFound = False
                        FirstAddress = rngFound.Address
                        Do
                            Set rngFound = rngCities.FindNext(rngFound)
                            If rngFound.Offset(, -1).Value = Cell.Offset(, 1).Value Then
                                Cell.Offset(, 2).Value = rngFound.Offset(, 1).Value
                                bolFound = True
                                Exit Do
                            End If
                        Loop While Not rngFound.Address = FirstAddress
                        
                        If Not bolFound Then Cell.Offset(, 2).Value = "[Other]"
                    Else
                        Cell.Offset(, 2).Value = rngFound.Offset(, 1).Value
                    End If
                    Set rngFound = Nothing
                End If
            Else
                Cell.Offset(, 2).Value = "[Other]"
            End If
        Next
    End With
End Sub
    
Function RangeFound(SearchRange As Range, _
                    Optional ByVal FindWhat As String = "*", _
                    Optional StartingAfter As Range, _
                    Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
                    Optional LookAtWholeOrPart As XlLookAt = xlPart, _
                    Optional SearchRowCol As XlSearchOrder = xlByRows, _
                    Optional SearchUpDn As XlSearchDirection = xlPrevious, _
                    Optional bMatchCase As Boolean = False) As Range
    
    If StartingAfter Is Nothing Then
        Set StartingAfter = SearchRange(1)
    End If
    
    Set RangeFound = SearchRange.Find(What:=FindWhat, _
                                      After:=StartingAfter, _
                                      LookIn:=LookAtTextOrFormula, _
                                      LookAt:=LookAtWholeOrPart, _
                                      SearchOrder:=SearchRowCol, _
                                      SearchDirection:=SearchUpDn, _
                                      MatchCase:=bMatchCase)
End Function

Two issues are that a few listings are doubled, such as Bowling Green, Virginia (In one case, City of Fredericksburg / Spotsylvania / Stafford/Caroline is listed as the county, in the other, Caroline.) and that some cities are like named in different states. By example, Brentwood is a city in both California and Tennessee.

In the first issue, this just grabs the first one it finds. For the second, if two like-named cities are found, the state name is compared.

This does not make any attempts are different spellings, like Gainesville or Ft. Worth vs Fort Worth, etc.

Hope it helps,

Mark

[av8tordude]

Hi GTO,

Thank you, the code works great.