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. :friends: