Results 1 to 3 of 3

Thread: Solved: Lookup County

  1. #1

    Solved: Lookup County

    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.
    Attached Files Attached Files

  2. #2
    Knowledge Base Approver VBAX Guru GTO's Avatar
    Sep 2008
    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
                        Set rngFound = RangeFound(rngCities, Cell.Value, , , xlWhole)
                        If Not rngFound.Offset(, -1).Value = Cell.Offset(, 1).Value Then
                            bolFound = False
                            FirstAddress = rngFound.Address
                                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]"
                            Cell.Offset(, 2).Value = rngFound.Offset(, 1).Value
                        End If
                        Set rngFound = Nothing
                    End If
                    Cell.Offset(, 2).Value = "[Other]"
                End If
        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, _
    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,


  3. #3
    Hi GTO,

    Thank you, the code works great.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts