By: Lutfor Rahman Shimanto

In reply to Peter Berger.

Hello Peter Berger

Thanks for your nice words. Your appreciation means a lot to us.

You wanted to get all the address information in different columns. To do so, I have developed another assistive VBA user-defined function and improved the existing user-defined function named ReverseGeocoder. Using these two functions, you can quickly fulfil your goal.

Follow these steps:

Press Alt+F11.

Click on Insert followed by Module.

Paste the following improved code in the module and save it:
Option Explicit

Function ReverseGeocoder(lati As Double, longi As Double) As Variant
On Error GoTo 0

Dim xD As New MSXML2.DOMDocument
Dim URL As String, vbErr As String

xD.async = False
URL = "https://nominatim.openstreetmap.org/reverse?lat=" + CStr(lati) + _
"&lon=" + CStr(longi)

xD.Load ("https://nominatim.openstreetmap.org/reverse?lat=" + CStr(lati) + _
"&lon=" + CStr(longi))

If xD.parseError.ErrorCode <> 0 Then
Application.Caller.Font.ColorIndex = vbErr
ReverseGeocoder = xD.parseError.reason
Else
xD.SetProperty "SelectionLanguage", "XPath"
Dim loca As MSXML2.IXMLDOMElement
Set loca = xD.SelectSingleNode("/reversegeocode/result")

If loca Is Nothing Then
Application.Caller.Font.ColorIndex = vbErr
ReverseGeocoder = xD.XML
Else
Application.Caller.Font.ColorIndex = vbOK
ReverseGeocoder = SplitStringToArray(loca.Text)

End If
End If

Exit Function

0:
Debug.Print Err.Description

End Function

Function SplitStringToArray(strInput As String) As Variant

Dim arrResult As Variant
Dim i As Integer

arrResult = Split(strInput, ", ")

For i = LBound(arrResult) To (UBound(arrResult) - 1) / 2
Dim temp As String
temp = arrResult(i)
arrResult(i) = arrResult(UBound(arrResult) - i)
arrResult(UBound(arrResult) - i) = temp
Next i

If Not IsNumeric(arrResult(1)) Then

ReDim Preserve arrResult(UBound(arrResult) + 1)
For i = UBound(arrResult) - 1 To 1 Step -1
arrResult(i + 1) = arrResult(i)
Next i

arrResult(1) = ""

End If

SplitStringToArray = arrResult

End Function

Return to the sheet and select the intended cell.

Insert the following formula: =ReverseGeocoder(B5,C5)

Hit Enter to see an output like the following GIF.

Now, drag the Fill Handle icon to copy the formula down.

I hope you have found the VBA user-defined function helpful. I have attached the solution workbook; good luck.

DOWNLOAD SOLUTION WORKBOOK

Regards
Lutfor Rahman Shimanto
Excel & VBA Developer
ExcelDemy