The code for the macro is split into a couple of different bits, the main Sub is the CutListHandler - this is the function called when the generate cutlist button is pressed:
Sub CutListHandler()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Cut List")
'Set kerf
Dim kerf As String
kerf = ws.Cells(2, 12)
'Set output last row
Dim lastRow As Long
lastRow = 0
Dim x As Integer
'First do the available materials table
'Subtract the header rows from the number of filled table rows
Dim NumRows As Long
NumRows = ws.Range("A" & Rows.Count).End(xlUp).Row - 3
' Get a collection of all of the material types
Dim MaterialsCol As New Collection
Set MaterialsCol = MaterialsList(ws, "D" & x + 4 & ":" & "D" & NumRows + 4)
For Each Material In MaterialsCol
If Len((Material)) Then
Dim Parameters As Collection
Set Parameters = GenerateParameters((Material), ws, NumRows)
If Len(Parameters("availableStock")) And Len(Parameters("desiredPieces")) Then
Dim Response As WebResponse
Set Response = GenerateCutlist(Parameters("availableStock"), Parameters("desiredPieces"), kerf)
lastRow = ResponseOutput(Response, ws, lastRow)
End If
End If
Next
End SubThe first custom function is the MaterialsList function, which gets the available materials from the table in your sheet:
'Get a unique list of materials
Function MaterialsList(ws As Worksheet, MaterialListRange As String) As Collection
Dim MaterialsListColumn As Range: Set MaterialsListColumn = ws.Range(MaterialListRange)
Dim MaterialsDictionary As New Dictionary
For Each c In ws.Range(MaterialListRange)
If MaterialsDictionary.Exists(c.Value) = False Then
MaterialsDictionary.Add c.Value, 1
ElseIf MaterialsDictionary.Exists(c.Value) Then
MaterialsDictionary(c.Value) = MaterialsDictionary(c.Value) + 1
End If
Next c
Set MaterialsList = New Collection
With MaterialsDictionary
For Each k In .Keys
MaterialsList.Add k
Next k
End With
End FunctionThe next function - GenerateParameters - makes the parameters array to be passed to the cutlist API:
'Generate the parameter strings (available and products) for a given material type
Function GenerateParameters(Material As String, ws As Worksheet, NumRows As Long) As Collection
Dim materials() As String
'ReDim materials(NumRows, 4)
Dim x As Long: x = 0
' Count the number of available boards of the passed material type
For Each c In ws.Range("A" & x + 4 & ":" & "A" & NumRows + 4)
If c.Offset(0, 3) = Material Then
x = x + 1
End If
Next c
'Create an array to hold all of the material boards
ReDim materials(x, 4)
x = 0
'Fill the array with parameter data
For Each c In ws.Range("A" & x + 4 & ":" & "A" & NumRows + 4)
If c.Offset(0, 3) = Material Then
materials(x, 0) = "'name': """ & c & """"
materials(x, 1) = "'length': " & c.Offset(0, 2)
materials(x, 2) = "'quantity': -1"
materials(x, 3) = "'cost': """ & c.Offset(0, 4) & """"
x = x + 1
End If
Next c
'Turn that array into an API parameter string
Dim joinedInfo() As String
ReDim joinedInfo(x)
For i = 0 To x - 1
For j = 0 To 3
If j = 0 Then
joinedInfo(i) = "{" & materials(i, j)
Else
joinedInfo(i) = joinedInfo(i) & "," & materials(i, j)
End If
Next j
joinedInfo(i) = joinedInfo(i) & "}"
Next i
Dim availableStock As String: availableStock = "[" & Left(Join(joinedInfo, ","), Len(Join(joinedInfo, ",")) - 1) & "]"
Debug.Print (availableStock)
'Then do the desired pieces table
'Subtract the header rows from the number of filled table rows
NumRows = ws.Range("G" & Rows.Count).End(xlUp).Row - 3
x = 0
Dim Products() As String
For Each c In ws.Range("G" & x + 4 & ":" & "G" & NumRows + 4)
If c.Offset(0, 2) = Material Then
x = x + 1
End If
Next c
If x Then
ReDim Products(x, 2)
x = 0
For Each c In ws.Range("G" & x + 4 & ":" & "G" & NumRows + 4)
If c.Offset(0, 2) = Material Then
Products(x, 0) = "'length': " & c
Products(x, 1) = "'quantity': " & c.Offset(0, 1)
x = x + 1
End If
Next c
ReDim joinedInfo(x)
For i = 0 To x - 1
For j = 0 To 1
If j = 0 Then
joinedInfo(i) = "{" & Products(i, j)
Else
joinedInfo(i) = joinedInfo(i) & "," & Products(i, j)
End If
Next j
joinedInfo(i) = joinedInfo(i) & "}"
Next i
Dim desiredPieces As String: desiredPieces = "[" & Left(Join(joinedInfo, ","), Len(Join(joinedInfo, ",")) - 1) & "]"
Else
desiredPieces = ""
End If
Debug.Print (desiredPieces)
Set GenerateParameters = New Collection
GenerateParameters.Add availableStock, "availableStock"
GenerateParameters.Add desiredPieces, "desiredPieces"
End FunctionGenerateCutlist is the actual API calling function, it passes neccessary data to the API and returns the WebResponse:
Function GenerateCutlist(availableStock As String, desiredPieces As String, kerf As String) As WebResponse
If (Len(availableStock) And Len(desiredPieces)) Then
Dim CutClient As New WebClient
CutClient.BaseUrl = "http://cutlist.dotordotdot.com/json/"
' Create a WebRequest for getting CutList information
Dim CutListRequest As New WebRequest
CutListRequest.Resource = "generate.cutlist.1d"
CutListRequest.Method = WebMethod.HttpPost
' Set the request format
' -> Sets content-type and accept headers and parses response
CutListRequest.Format = WebFormat.Json
CutListRequest.ResponseFormat = WebFormat.Json
' Replace {format} segment
CutListRequest.AddUrlSegment "format", "json"
' Add querystring to the request
CutListRequest.AddQuerystringParam "apiKey", "00000000-0000-0000-0000-000000000000"
CutListRequest.AddQuerystringParam "availableStock", availableStock
CutListRequest.AddQuerystringParam "desiredPieces", desiredPieces
CutListRequest.AddQuerystringParam "kerf", "" & kerf & ""
CutListRequest.AddQuerystringParam "algorithm", "legacy"
CutListRequest.AddQuerystringParam "lengthUnit", "inches"
Dim Response As WebResponse
Set Response = CutClient.Execute(CutListRequest)
Set GenerateCutlist = Response
End If
End FunctionThe response is then output to the Required Matierals list by the ResponseOutput function:
Function ResponseOutput(Response As WebResponse, ws As Worksheet, lastRow As Long) As Long
'This clears the Required Material table (currently hardcoded to clear 96 rows)
'Only occurs on first run
If lastRow = 0 Then
ws.Range("N4:P100").Clear
End If
'Set the output row and column for the first "Required Parts" cell (Currently N4)
Dim OutputColumn As Integer
OutputColumn = 14
Dim OutputRow As Integer
If lastRow = 0 Then
OutputRow = 4
Else
OutputRow = lastRow
End If
For Each board In Response.Data("availableStock")
If board("quantityConsumed") + 0 > 0 Then
'Outputs board name (SKU)
ws.Cells(OutputRow, OutputColumn) = board("name")
'Get price for the SKU from available material table
ws.Cells(OutputRow, OutputColumn + 1) = ws.Cells(ws.Range("A:A").Find(board("name")).Row, 5)
'Outputs quantity consumed (QTY)
ws.Cells(OutputRow, OutputColumn + 2) = board("quantityConsumed") + 0
OutputRow = OutputRow + 1
End If
Next board
ResponseOutput = OutputRow
End FunctionWith a bit of effort, this should be enough information for you to integrate Jonathan Overholt's cutlist API into your own Excel projects.
Thanks for taking a look! Please contact me with questions or suggestions: [email protected]