VBA code to find French cities associated to a given postal code

code_postal.vba

Function collectionToArray(c As Collection) As Variant()
    Dim a() As Variant: ReDim a(0 To c.Count - 1)
    Dim i As Integer
    For i = 1 To c.Count
        a(i - 1) = c.Item(i)
    Next
    collectionToArray = a
End Function


Private Sub Worksheet_Change(ByVal Target As Range)
  Dim row As Integer
  Dim code As String
  Dim villes As New Collection
  Dim f As Worksheet
  Dim cells As Range
  Dim firstAddress

  If Target.cells.Count = 1 And Target.cells(1, 1).Column = 7 Then

    row = Target.cells(1, 1).row
    code = Target.cells(1, 1).Text

    If IsEmpty(Target.cells(1, 1)) Then
      Range("H" & row).Validation.Delete
    Else

      With Worksheets(8).Range("A2:A50000")
        Set c = .Find(code, LookIn:=xlValues)
        If Not c Is Nothing Then
          firstAddress = c.Address
          Do
            villes.Add c.Offset(0, 1).Text
            Set c = .FindNext(c)
          Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
      End With

      With Range("H" & row).Validation
          .Delete
          .Add Type:=xlValidateList, _
               Formula1:=Join(collectionToArray(villes), ",")
      End With

    End If
  End If
End Sub