Attribute VB_Name = "GetDataAllPlants" Sub getAllPlants(ByVal query As String) Dim req As New WinHttpRequest Dim json As Object Dim dataArray As Object Dim headerRow As Range Dim plantData As Range Dim reqUrl As String Dim firstRound As Boolean Dim lastRow As Long 'where is our plant data to match too? Set plantData = Sheet2.Range("A2:A30") Debug.Print "All plants running and the endpoint that will be hit: " & query 'check if the data sheet was removed or changed and recreate it it was changed and then clear the data On Error Resume Next Set ws = Sheets("Data") If ws Is Nothing Then Set ws = Sheets.Add ws.Name = "Data" Else 'ws.Cells.Clear ' Clear existing data if the sheet already exists End If On Error GoTo 0 firstRound = False For Each cell In plantData 'Debug.Print "Server that was selected : " & cell.Offset(0, 1).Value If cell.Value <> "" Then ' we dont want to try and get localhost If cell.Value = "Dev Server" Then GoTo SkipIteration End If ' skip the test server too If cell.Value = "TestServer" Then GoTo SkipIteration End If ' as iowa pet is on a differnt port we want to grab keep everything the same If cell.Value = "Iowa ISBM, Iowa" Then reqUrl = "http://" & cell.Offset(0, 1).Value & ":3001" & query Else reqUrl = "http://" & cell.Offset(0, 1).Value & ":3000" & query End If Debug.Print reqUrl On Error Resume Next ' Ignore errors and continue execution 'url is created get the request going. req.Open "GET", reqUrl, False req.Send If Err.Number <> 0 Then Debug.Print "An error occurred: " & Err.Description Else 'Debug.Print req.StatusText On Error GoTo 0 ' Reset error handling to default If req.Status <> 200 Then Debug.Print req.Status & " - " & req.StatusText Else ' Get the response text (JSON) jsonResponse = req.ResponseText Set json = JsonConverter.ParseJson(jsonResponse) Set dataArray = json("data") 'how many we got Debug.Print dataArray.Count ' Check if dataArray is empty If dataArray.Count = 0 Then 'MsgBox "There is no data for " & cell.Value & ", if you this is an error please try again, if repeats please constact support.", vbExclamation, "No Data" 'Exit Sub 'just stop doing anything else End If 'if we have over 15k lines just exit and direct the user to get the data from lst If dataArray.Count > 15000 Then MsgBox "There is more than 15,000 lines of data please, export the data from LST\n for perforance reasons no data will be loaded", vbExclamation, "No Data" 'Exit Sub 'just stop doing anything else End If 'for the first plant we want to add the headers and then not do it again. ' Set up the headers in the first row just for a reference Set headerRow = Sheets("Data").Range("A1") ' Dump the querys into the table so we can use it in our list :) If json("success") Then 'Debug.Print "First plant" If Not firstRound Then 'add the headers Debug.Print "Running as first plant" Sheets("Data").Range("A5:BB50000").ClearContents ' Loop through the first item to get the keys (name, endpoint) h = 1 For Each Item In dataArray(1).Keys 'Debug.Print Item headerRow.Cells(5, h).Value = Item ' Place the key as a header h = h + 1 Next Item firstRound = True End If 'add the rows in. ' Disable screen updating and calculations for faster execution Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ' Debug.Print "Column count " & h ' Populate data row by row 'For j = 1 To dataArray.Count ' For x = 1 To h ' 'Debug.Print dataArray(j)(headerRow.Cells(1, i).Value) ' ws.Cells(j + 1, x).Value = dataArray(j)(headerRow.Cells(1, x).Value) ' Next x 'Next j 'Dim lastRow As Long lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row lastRow = Application.Max(4, lastRow) ' Populate data row by row, starting from the lastRow + 1 For j = 1 To dataArray.Count For x = 1 To h ws.Cells(lastRow + j, x).Value = dataArray(j)(headerRow.Cells(5, x).Value) Next x Next j ' Re-enable screen updating and calculations Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic ' Determine the last column used based on the number of headers lastColumn = h ' Automatically adjust the width of all used columns ws.Columns(1).Resize(, lastColumn).AutoFit ' Adjust based on last column End If End If End If End If SkipIteration: ' Label to jump to the next iteration Next cell MsgBox "Data processing successful!" End Sub