Attribute VB_Name = "GetData" Sub getData() On Error GoTo ErrorHandler ' Enable error handling Dim plantSelect As String Dim req As New WinHttpRequest Dim reqUrl As String Dim cell As Range Dim plantFound As Boolean Dim plantData As Range Dim queryData As Range Dim server As String Dim queryToRun As String Dim ws As Worksheet Dim lastColumn As Integer Dim dataRange As Variant Dim json As Object Dim dataArray As Object Dim headerRow As Range 'where is our plant data to match too? Set plantData = Sheet2.Range("A1:B30") Set queryData = Sheet2.Range("D2:E100") ' what plant is selected plantSelect = Sheets("Data").Range("E1").Value 'until the all function is created send a message box to check the server 'If plantSelect = "All" Then ' MsgBox "The ""All"" function is not fully operational please select a plant to move forward" ' Exit Sub 'End If 'if we are missing the query we want to warn everyone too If Sheets("Data").Range("G1").Value = "" Then MsgBox "Please select a query you want to pull before pressing the ""Get data"" button." End If '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 Sheets("Data").Range("A5:BB50000").ClearContents End If On Error GoTo 0 'go back to the setup data sheet maybe :P Sheets("Data").Select ' Sheets("Data").Range("A5:BB50000").ClearContents ' create the url from the plan plantFound = False For Each cell In plantData If cell.Value = plantSelect Then ' Found the server If cell.Value = "All" Then Debug.Print "all servers were selected" Exit For Else 'Debug.Print "Server that was selected : " & cell.Offset(0, 1).Value server = cell.Offset(0, 1).Value Exit For End If Exit For End If Next cell 'get the query endpoint For Each cell In queryData If cell.Value = Sheets("Data").Range("G1").Value Then 'Debug.Print "Server that was selected : " & cell.Offset(0, 1).Value queryToRun = cell.Offset(0, 1).Value Exit For End If Next cell ' if the query would have extra parameters add them here For Each cell In queryData If cell.Value = Sheets("Data").Range("G1").Value Then 'Debug.Print "Server that was selected : " & cell.Offset(0, 1).Value 'queryToRun = queryToRun + cell.Offset(0, 2).Value 'add the first part of the additional critiera to the query If Sheets("Data").Range("D2").Value <> "" Then If Trim(Sheets("Data").Range("D2").Value) <> "" And Trim(Sheets("Data").Range("D3").Value) <> "" Then queryToRun = queryToRun & "?" & Sheets("Data").Range("D2").Value & "=" & Sheets("Data").Range("D3").Value If Sheets("Data").Range("E2").Value <> "" And Sheets("Data").Range("E3").Value <> "" Then queryToRun = queryToRun & "&" & Sheets("Data").Range("E2").Value & "=" & Sheets("Data").Range("E3").Value If Sheets("Data").Range("F2").Value <> "" And Sheets("Data").Range("F3").Value <> "" Then queryToRun = queryToRun & "&" & Sheets("Data").Range("F2").Value & "=" & Sheets("Data").Range("F3").Value End If End If ElseIf Trim(Sheets("Data").Range("E2").Value) <> "" And Trim(Sheets("Data").Range("E3").Value) <> "" Then queryToRun = queryToRun & "?" & Sheets("Data").Range("E2").Value & "=" & Sheets("Data").Range("E3").Value End If End If Exit For End If Next cell 'Debug.Print queryToRun If plantSelect = "All" Then 'reqUrl = "http://localhost:4000" & queryToRun getAllPlants queryToRun Exit Sub Else ' as iowa pet is on a differnt port we want to grab keep everything the same If plantSelect = "Iowa ISBM, Iowa" Then reqUrl = "http://" & server & ":3001" & queryToRun Else reqUrl = "http://" & server & ":3000" & queryToRun End If End If Debug.Print reqUrl 'url is created get the request going. req.Open "GET", reqUrl, False req.Send If req.Status <> 200 Then MsgBox req.Status & " - " & req.StatusText & " - " & req.ResponseText Exit Sub End If ' Get the response text (JSON) jsonResponse = req.ResponseText ' crtl + g to pull up the debut ' Debug print the raw JSON response 'Debug.Print jsonResponse Set json = JsonConverter.ParseJson(jsonResponse) Set dataArray = json("data") 'Debug.Print dataArray ' Check if dataArray is empty If dataArray.Count = 0 Then MsgBox "There is no data 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 ' 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 'add the headers ' 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 ' Disable screen updating and calculations for faster execution Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ' Debug.Print "Column count " & h ' Populate data row by row Dim cellValue As Variant Dim rowIndex As Integer rowIndex = 6 ' Start from row 6 For j = 1 To dataArray.Count ' Iterate from the first element of dataArray For x = 1 To h 'ws.Cells(rowIndex, x).Value = dataArray(j)(headerRow.Cells(5, x).Value) cellValue = dataArray(j)(headerRow.Cells(5, x).Value) If VarType(cellValue) = vbString Then ws.Cells(rowIndex, x).Value = "'" & cellValue ' Prefixing with apostrophe forces Excel to treat it as text Else ws.Cells(rowIndex, x).Value = cellValue End If Next x rowIndex = rowIndex + 1 ' Move to the next row 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 Sheets("Data").Select MsgBox "Data processing successful!" Else MsgBox "Error: " & json("message") End If Exit Sub ErrorHandler: ' Handle specific error for connection issues If Err.Number = -2147012867 Then MsgBox "Please make sure you are connected to vpn, and or make sure the server is online.", vbCritical ElseIf Err.Number = -2147012894 Then MsgBox "Server is not reachable please try again later." ' Handle other errors MsgBox "An unexpected error occurred: " & Err.Description, vbCritical End If End Sub