diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 0000000..f4927ba --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,3 @@ +{ + "editor.snippetSuggestions": "top", +} \ No newline at end of file diff --git a/Main.bas b/Main.bas index 7e77a7e..deb4c12 100644 --- a/Main.bas +++ b/Main.bas @@ -1,6 +1,5 @@ Attribute VB_Name = "Main" -Sub main() -'get the av data based on what is in cell b24 -msgbox "The av to grab are" + sheets("Setup Data").range("B24").value -End Sub +sub main () +debug.print "just here" +end sub diff --git a/README.md b/README.md index 37c86e4..63df6ea 100644 --- a/README.md +++ b/README.md @@ -6,5 +6,5 @@ This is a standard psi based off the dayton abbott one XLWINGS should be installed to run this and update the macro once installed run ``` -xlwings vba edit .\MacroTemplate2.0.xlsm +xlwings vba edit .\StandardPSI.xlsm ``` \ No newline at end of file diff --git a/StandardPSI.xlsm b/StandardPSI.xlsm index 5b606e5..e106248 100644 Binary files a/StandardPSI.xlsm and b/StandardPSI.xlsm differ diff --git a/createSheets.bas b/createSheets.bas index ffa45f6..613d0aa 100644 --- a/createSheets.bas +++ b/createSheets.bas @@ -1,50 +1,97 @@ Attribute VB_Name = "createSheets" -Sub CreateSheetIfNotExist() +Sub createOrUpdateArticles() +Dim cellValue As String +Dim articles As Variant +Dim ws As Worksheet +Dim keepSheets As Object - Dim cellValue As String - Dim sheetNames As Variant - Dim i As Long - Dim ws As Worksheet - Dim sheetExists As Boolean +' Initialize the collection for sheets to keep + Set keepSheets = CreateObject("Scripting.Dictionary") - ' Articles seperated by a , - cellValue = ThisWorkbook.Sheets("Setup Data").Range("B24").Value +' Static sheets to keep + keepSheets.Add "Setup Data", True + 'keepSheets.Add "8oz data", True + 'keepSheets.Add "10oz data", True + 'keepSheets.Add "COA Needs", True + 'keepSheets.Add "Approved COA's", True + 'keepSheets.Add "Forecast", True + 'keepSheets.Add "Truck list", True + 'keepSheets.Add "planningNumbers", True + 'keepSheets.Add "productionNumbers", True + 'keepSheets.Add "stockNumbers", True + 'keepSheets.Add "Delivered", True - ' Split the comma-separated string into an array of sheet names - sheetNames = Split(cellValue, ",") - Debug.Print "Value in the cell: " & cellValue +'get the av data based on what is in cell b24 - ' Split the comma-separated string into an array of sheet names - sheetNames = Split(cellValue, ",") - Debug.Print "Result of Split function:" - For i = LBound(sheetNames) To UBound(sheetNames) - Debug.Print " Index " & i & ": """ & sheetNames(i) & """" - Next i +cellValue = ThisWorkbook.Sheets("Setup Data").Range("B4").Value +articles = Split(cellValue, ",") +count = UBound(articles) - LBound(articles) + 1 - ' Loop through each potential sheet name - For i = LBound(sheetNames) To UBound(sheetNames) - Dim newSheetName As String - newSheetName = Trim(sheetNames(i)) ' Remove any leading/trailing spaces +' clear the table so when we run the setup it only shows us clean data. +sheets("Setup Data").range("A19:G" & 19 + count + 20).ClearContents - sheetExists = False - ' Check if the sheet already exists - For Each ws In ThisWorkbook.Sheets - If ws.Name = newSheetName Then - sheetExists = True - Exit For - End If - Next ws +' create the table start for the av we will be utlizeing. +dim i as Integer - ' If the sheet doesn't exist, create it - If Not sheetExists Then - On Error Resume Next ' In case there's an issue creating the sheet - ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) - ActiveSheet.Name = newSheetName - On Error GoTo 0 ' Resume normal error handling - Debug.Print "Sheet '" & newSheetName & "' created." +For i = LBound(articles) To UBound(articles) +' Get a trimmed version of the article name for easier use + sheetName = "Article " & Trim(articles(i)) + keepSheets.Add sheetName, True + ' Debug output for tracking + Debug.Print "Article to be placed is: " & Trim(articles(i)) + + ' Place the articles in the Setup Data Sheet at specific range + 'ThisWorkbook.Sheets("Setup Data").Range("A" & 19 + i).Value = Trim(articles(i)) + + ' Initialize the ws object to Nothing before checking existence + Set ws = Nothing + + ' Attempt to set ws to an existing sheet with the desired name + On Error Resume Next + Set ws = ThisWorkbook.Sheets(sheetName) + On Error GoTo 0 + + ' If the sheet doesn't exist, add it + If ws Is Nothing Then + On Error Resume Next + Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) + ws.Name = sheetName + call formatArticleSheet.formatArticleSheet(Trim(articles(i)), sheetName) + On Error GoTo 0 Else - Debug.Print "Sheet '" & newSheetName & "' already exists." + ws.Visible = xlSheetVisible End If - Next i -End Sub +Next i + +' Clean up the sheets so we only ever have the correct data. + For Each ws In ThisWorkbook.Worksheets + wsName = ws.Name + If keepSheets.exists(wsName) Then + Debug.Print wsName & " is inside the keepSheets Dictionary" + Else + Debug.Print wsName & " is not inside the keepSheets Dictionary" + Application.DisplayAlerts = False + ' Uncomment to delete or hide based on your preference + ws.Delete + ' ws.Visible = xlSheetHidden + Application.DisplayAlerts = True + End If + Next ws + +call getArticleData.getArticleData +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 \ No newline at end of file diff --git a/formatArticleSheet.bas b/formatArticleSheet.bas new file mode 100644 index 0000000..e5086cc --- /dev/null +++ b/formatArticleSheet.bas @@ -0,0 +1,14 @@ +Attribute VB_Name = "formatArticleSheet" +Sub formatArticleSheet(ByVal article As String, ByVal sheet as string) +' +'This will format the sheet based on the og psi, all formulas will be rebuilt everytime you click update articles +' +' +' +' +' +' + +sheets(sheet).range("A2").value = "AV" +sheets(sheet).range(article) +End Sub diff --git a/getArticleData.bas b/getArticleData.bas new file mode 100644 index 0000000..b642476 --- /dev/null +++ b/getArticleData.bas @@ -0,0 +1,74 @@ +Attribute VB_Name = "getArticleData" +public sub getArticleData() +Dim port as string +Dim req As New WinHttpRequest +Dim statusMessage as string +dim url as string +Dim json As Object +Dim dataArray As Object +dim headerRow as range +dim h as Integer +Dim cellValue As Variant +Dim rowIndex As Integer + +' The server and url stuff will change once we move to the new version of lst running on go in iis +server = Sheets("Setup Data").Range("B5").Value +token = Sheets("Setup Data").Range("B6").Value +articles = Sheets("Setup Data").Range("B4").value + +port = 3000 +if token = "usiow2" then + port = 3001 +end if +url = "http://" & server & ":" &port &"/api/datamart/psiarticledata?avs=" & articles +debug.print url + +req.Open "GET", url, False + +req.Send + +jsonResponse = req.ResponseText + +Set json = JsonConverter.ParseJson(jsonResponse) +If req.Status <> 200 Then +'"Message: " & req.StatusText & vbNewLine & + message = "StatusCode " & req.Status & vbNewLine & _ + "Message : " & json("message") + MsgBox message, vbInformation, "Server Error" + + End If + + +Set dataArray = json("data") +Set headerRow = Sheets("Setup Data").Range("A18") + +If req.Status = 200 Then + ' add the headers + h = 1 + for each Item in dataArray(1).Keys + if Item <> "Id" then + headerRow.Cells(1, h).value = Item + h = h +1 + end if + next Item + + rowIndex = 19 'starts at this row + + For j = 1 To dataArray.Count + For x = 1 To h + + cellValue = dataArray(j)(headerRow.Cells(1, x).Value) + Debug.Print "Header: " & dataArray(j)(headerRow.Cells(1, x).Value) + + + If VarType(cellValue) = vbString Then + Sheets("Setup Data").Cells(rowIndex, x).Value = "'" & cellValue ' Prefixing with apostrophe forces Excel to treat it as text + Else + Sheets("Setup Data").Cells(rowIndex, x).Value = cellValue + End If + Next x + rowIndex = rowIndex + 1 ' Move to the next row + Next j + +end if +end sub \ No newline at end of file