Try this version
Sub GetData_Demo()
Dim ws As Worksheet, r As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")
For r = 1 To ws.Cells(Rows.Count, 1).End(xlUp).Row
GetData ws.Cells(r, 1).Value, ws.Name, r, 2
Next r
End Sub
Sub GetData(ByVal sID As String, ByVal wsName As String, ByVal lRow As Long, ByVal lCol As Long)
Const sURL As String = "https://www.elta-courier.gr/track.php"
Dim a, http As MSXML2.ServerXMLHTTP60, col As Collection, json As Object, postData As String, sResp As String, i As Long, cnt As Long
Set http = New MSXML2.ServerXMLHTTP60
postData = "number=" & sID
With http
sPoint:
.Open "POST", sURL, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send postData
.waitForResponse
sResp = .responseText
If InStr(sResp, "Fatal error") Then cnt = cnt + 1: Debug.Print "Wait .. " & cnt: GoTo sPoint
End With
Set json = JSONConverter.ParseJson(sResp)
Set col = json("result")(sID)("result")
ReDim a(1 To col.Count, 1 To 1)
For i = 1 To col.Count
a(i, 1) = col.item(i)("status")
Next i
ThisWorkbook.Worksheets(wsName).Cells(lRow, lCol).Value = a(2, 1)
End Sub
* I have updated the code as I noticed the site is down sometimes.