Find best combination of numbers to meet a goal

Option Explicit


Public Sub AddBestCombinationRowToOrder()


Dim blnCombinationMatched As Boolean
Dim intOrder As Integer
Dim lngRow As Long
Dim lngRowUndo As Long
Dim strAddComment As String
Dim strFind As String
Dim rngFoundCell As Range
Dim vntArrayBestCombination As Variant
Dim vntBestCombination As Variant


' Create header.
wsOrder.Cells(1, "B") = "Best Combination Row "


' Loop through the best combinations.
For lngRow = 2 To LastRow(wsBestCombinations, 1)
    vntBestCombination = Replace(wsBestCombinations.Cells(lngRow, "A"), "[", "")
    vntArrayBestCombination = Split(vntBestCombination, "]")
    ' Match the combinations with the order lengths.
    For intOrder = LBound(vntArrayBestCombination) To UBound(vntArrayBestCombination)
        With wsOrder
             If Trim(vntArrayBestCombination(intOrder)) <> "" Then
                Set rngFoundCell = .Columns("A").Find(What:=Trim(vntArrayBestCombination(intOrder)), After:=.Cells(1, 1), LookIn:=xlFormulas, _
                                   LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            
                If Not rngFoundCell Is Nothing Then
                   ' Tag and highlight the order.
                   rngFoundCell.Value = rngFoundCell.Value & " X"
                   rngFoundCell.Interior.Color = vbYellow
                   wsOrder.Cells(rngFoundCell.Row, "B") = lngRow
                   strAddComment = "Combination: " & vbCrLf & wsBestCombinations.Cells(lngRow, "A") & vbCrLf & "Wastage: " & vbCrLf & _
                                    wsBestCombinations.Cells(lngRow, "C") & " %"
                   wsOrder.Cells(rngFoundCell.Row, "B").AddComment (strAddComment)
                Else
                   blnCombinationMatched = False
                End If
             End If
       End With
    Next
    
    If blnCombinationMatched = False Then
       ' Undo the Tag and highlight for the order.
       For lngRowUndo = 2 To LastRow(wsOrder, 1)
           If wsOrder.Cells(lngRowUndo, "B") = lngRow Then
              wsOrder.Cells(lngRowUndo, "A") = Replace(wsOrder.Cells(lngRowUndo, "A"), " X", "")
              wsOrder.Cells(lngRowUndo, "A").Interior.Color = xlNone
              wsOrder.Cells(lngRowUndo, "B") = ""
              wsOrder.Cells(lngRowUndo, "B").ClearComments
            End If
       Next
        
       blnCombinationMatched = True
    End If
Next


' Format wsOrder.
wsOrder.Select
wsOrder.Rows("1:1").Select
Selection.Font.Bold = True
wsOrder.Cells.Select
Selection.Columns.AutoFit


' Sort wsOrder.
wsOrder.Columns("B:B").Select
wsOrder.Sort.SortFields.Clear
wsOrder.Sort.SortFields.Add2 Key:=Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With wsOrder.Sort
    .SetRange Range("A2:B" & Trim(Str(LastRow(wsBestCombinations, 1))))
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With


End Sub


Function BestCombinations(intStockPieceLengthmm As Integer, intNoOfItemsToCutFromStockPiece As Integer, strStock As String)


' Change if you require less wastage.
Const MaximumWastePercent = 15
Dim intField As Integer
Dim intTotalLengthToCutFromStockmm As Integer
Dim intTable As Integer
Dim intWaste As Integer
Dim lngBestCombinationCount As Long
Dim lngRecordCount As Long
Dim lngRow As Long
Dim vntWastePercent As Variant
Dim objConnection As Object
Dim objRecordset As Object
Dim strCombination As String
Dim strFieldValue As String
Dim strSQL As String


' Delete existing data.
wsBestCombinations.Select
wsBestCombinations.Cells.Select
Selection.Delete Shift:=xlUp
' Create headings.
wsBestCombinations.Cells(1, "A") = "Combination"
wsBestCombinations.Cells(1, "B") = "Combination Length"
wsBestCombinations.Cells(1, "C") = "Stock " & strStock & " Wastage %"


' Create the SQL Tables for the cross join query.
wsOrder.Select
wsOrder.Columns("A").Select
Selection.Copy
For intTable = 1 To intNoOfItemsToCutFromStockPiece
    wsOrder.Columns(intTable + 1).Select
    wsOrder.Paste
Next


Set objConnection = CreateObject("ADODB.Connection")
Set objRecordset = CreateObject("ADODB.Recordset")


With objConnection
     .Provider = "Microsoft.ACE.OLEDB.12.0"
     .ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
     .Open
End With


' Build the SQL cross join query.
' A cross join (or cartesian join) is used when you wish to create combination of every row from two or more tables.  All row combinations
' are included in the result.
For intTable = 1 To intNoOfItemsToCutFromStockPiece
    strSQL = strSQL & "[" & ColumnLetter(intTable + 1) & ":" & ColumnLetter(intTable + 1) & "]"
    If intTable <> intNoOfItemsToCutFromStockPiece Then strSQL = strSQL & ", "
Next


strSQL = "SELECT * FROM " & strSQL


' Run the query.
objRecordset.Open strSQL, objConnection


lngRow = 2


' Loop through the record set
Do Until objRecordset.EOF
   On Error GoTo ErrorBestCombinations
   For intField = 0 To objRecordset.Fields.Count - 1
       intTotalLengthToCutFromStockmm = intTotalLengthToCutFromStockmm + objRecordset(intField)
       strCombination = strCombination & "[" & objRecordset(intField) & "] "
   Next
  
   ' Check if the combination is within the allowable MaximumWastePercent if so then output it.
   intWaste = intStockPieceLengthmm - intTotalLengthToCutFromStockmm
  
   If intWaste < 0 Then
      ' The stock length has been exceeded
   Else
      ' Work out the waste percentage.
      vntWastePercent = Round((intWaste / intStockPieceLengthmm) * 100, 3)


      If vntWastePercent <= MaximumWastePercent Then
         ' The combination is within the acceptable wastage limit so output it.
         lngBestCombinationCount = lngBestCombinationCount + 1
         wsBestCombinations.Cells(lngRow, "A") = strCombination
         wsBestCombinations.Cells(lngRow, "B") = intTotalLengthToCutFromStockmm
         wsBestCombinations.Cells(lngRow, "C") = vntWastePercent
        
         lngRow = lngRow + 1
      End If
   End If
  
   ' Set the variables ready for the next record.
   intTotalLengthToCutFromStockmm = 0
   strCombination = ""


   objRecordset.MoveNext
  
   lngRecordCount = lngRecordCount + 1
Loop


objRecordset.Close
objConnection.Close


Set objRecordset = Nothing
Set objConnection = Nothing


' Remove the duplicate combinations.
wsBestCombinations.Columns("A:A").Select
wsBestCombinations.Range("A1:C" & LastRow(wsBestCombinations, 1)).RemoveDuplicates Columns:=1, Header:=xlYes


' Format wsBestCombinations.
wsBestCombinations.Select
wsBestCombinations.Rows("1:1").Select
Selection.Font.Bold = True
wsBestCombinations.Cells.Select
Selection.Columns.AutoFit


' Sort wsBestCombinations.
wsBestCombinations.Columns("C:C").Select
wsBestCombinations.Sort.SortFields.Clear
wsBestCombinations.Sort.SortFields.Add2 Key:=Range("C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With wsBestCombinations.Sort
    .SetRange Range("A2:C" & Trim(Str(LastRow(wsBestCombinations, 1))))
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With


' Delete the SQL Cross Join Query tables for each item to cut from the stock piece.
For intTable = intNoOfItemsToCutFromStockPiece To 1 Step -1
    wsOrder.Columns(intTable + 1).Delete Shift:=xlToLeft
Next


MsgBox "Finished analysing the best combinations." & vbCrLf & _
       Trim(Str(lngRecordCount)) & " possible combinations were analysed." & vbCrLf & _
       "Resulting in " & Trim(Str(lngBestCombinationCount)) & " possible best combinations.", _
       vbOKOnly + vbInformation, "Best Combinations Analysis Complete"


Exit Function


ErrorBestCombinations:
'Debug.Print "Error Number : "; Err.Number
'Debug.Print Err.Description
Resume Next


End Function


Public Function ColumnLetter(intColumnNumber As Integer) As String


If intColumnNumber > 26 Then
   ' 1st character: Subtract 1 to map the characters to 0-25,
   ' but you don't have to remap back to 1-26
   ' after the 'Int' operation since columns
   ' 1-26 have no prefix letter
   ' 2nd character: Subtract 1 to map the characters to 0-25,
   ' but then must remap back to 1-26 after
   ' the 'Mod' operation by adding 1 back in
   ' (included in the '65')
    ColumnLetter = Chr(Int((intColumnNumber - 1) / 26) + 64) & _
    Chr(((intColumnNumber - 1) Mod 26) + 65)
Else
   ' Columns A-Z
   ColumnLetter = Chr(intColumnNumber + 64)
End If


End Function


Public Function LastRow(objWorkSheetFindLastRow As Worksheet, intColFindLastRow As Integer) As Long


' Ensure that the column being passed is populated for all rows for the correct last row to be returned.
With objWorkSheetFindLastRow
     LastRow = .Cells(.Rows.Count, intColFindLastRow).End(xlUp).Row
End With


End Function


Sub TestCombinations()


' 6096mm (20ft)
' 12192mm (40ft)
' 18288mm (60ft)


Application.ScreenUpdating = False
' Change parameters to suit the required analysis.
BestCombinations 12192, 4, "40ft (12192mm)"
AddBestCombinationRowToOrder
Application.ScreenUpdating = True


End Sub

Option Explicit


Public Sub AddBestCombinationRowToOrder(objOrderWorksheet As Worksheet)


Dim blnCombinationMatched As Boolean
Dim intOrder As Integer
Dim lngRow As Long
Dim lngRowUndo As Long
Dim strAddComment As String
Dim strFind As String
Dim strJobNumber As String
Dim rngFoundCell As Range
Dim vntArrayBestCombination As Variant
Dim vntBestCombination As Variant


' Create header.
objOrderWorksheet.Cells(1, "C") = "Best Combination Row "


' Loop through the best combinations.
For lngRow = 2 To LastRow(wsBestCombinations, 1)
    vntBestCombination = Replace(wsBestCombinations.Cells(lngRow, "A"), "[", "")
    vntArrayBestCombination = Split(vntBestCombination, "]")
    ' Match the combinations with the order lengths.
    For intOrder = LBound(vntArrayBestCombination) To UBound(vntArrayBestCombination)
        With objOrderWorksheet
             If Trim(vntArrayBestCombination(intOrder)) <> "" Then
                Set rngFoundCell = .Columns("B").Find(What:=Trim(vntArrayBestCombination(intOrder)), After:=.Cells(2, 2), LookIn:=xlFormulas, _
                                   LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
             
                If Not rngFoundCell Is Nothing Then
                   ' Tag and highlight the order.
                   rngFoundCell.Value = rngFoundCell.Value & " X"
                   rngFoundCell.Interior.Color = vbYellow
                   objOrderWorksheet.Cells(rngFoundCell.Row, "C") = lngRow
                   strAddComment = "Combination: " & vbCrLf & wsBestCombinations.Cells(lngRow, "A") & vbCrLf & "Wastage: " & vbCrLf & _
                                    wsBestCombinations.Cells(lngRow, "C") & " %"
                   objOrderWorksheet.Cells(rngFoundCell.Row, "C").AddComment (strAddComment)
                Else
                   blnCombinationMatched = False
                End If
             End If
       End With
    Next
    
    If blnCombinationMatched = False Then
       ' Undo the Tag and highlight for the order.
       For lngRowUndo = 2 To LastRow(wsOrder, 1)
           If objOrderWorksheet.Cells(lngRowUndo, "C") = lngRow Then
              objOrderWorksheet.Cells(lngRowUndo, "B") = Replace(objOrderWorksheet.Cells(lngRowUndo, "B"), " X", "")
              objOrderWorksheet.Cells(lngRowUndo, "B").Interior.Color = xlNone
              objOrderWorksheet.Cells(lngRowUndo, "C") = ""
              objOrderWorksheet.Cells(lngRowUndo, "C").ClearComments
            End If
       Next
        
       blnCombinationMatched = True
    End If
Next


' Format objOrderWorksheet.
objOrderWorksheet.Select
objOrderWorksheet.Rows("1:1").Select
Selection.Font.Bold = True
objOrderWorksheet.Cells.Select
Selection.Columns.AutoFit


' Sort objOrderWorksheet.
objOrderWorksheet.Columns("C:C").Select
objOrderWorksheet.Sort.SortFields.Clear
objOrderWorksheet.Sort.SortFields.Add2 Key:=Range("C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With objOrderWorksheet.Sort
    .SetRange Range("A2:C" & Trim(Str(LastRow(objOrderWorksheet, 1))))
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With


End Sub


Function BestCombinations(objOrderWorksheet As Worksheet, intStockPieceLengthmm As Integer, intNoOfItemsToCutFromStockPiece As Integer, strStock As String)


' Change if you require less wastage.
Const MaximumWastePercent = 15
Dim intField As Integer
Dim intTotalLengthToCutFromStockmm As Integer
Dim intTable As Integer
Dim intWaste As Integer
Dim lngBestCombinationCount As Long
Dim lngRecordCount As Long
Dim lngRow As Long
Dim vntWastePercent As Variant
Dim objConnection As Object
Dim objRecordset As Object
Dim strCombination As String
Dim strFieldValue As String
Dim strSQL As String


' Delete existing data.
wsBestCombinations.Select
wsBestCombinations.Cells.Select
Selection.Delete Shift:=xlUp
' Create headings.
wsBestCombinations.Cells(1, "A") = "Combination"
wsBestCombinations.Cells(1, "B") = "Combination Length"
wsBestCombinations.Cells(1, "C") = "Stock " & strStock & " Wastage %"


' Create the SQL Tables for the cross join query.
objOrderWorksheet.Select
objOrderWorksheet.Columns("B").Select
Selection.Copy
For intTable = 1 To intNoOfItemsToCutFromStockPiece
    objOrderWorksheet.Columns(intTable + 2).Select
    objOrderWorksheet.Paste
Next


Set objConnection = CreateObject("ADODB.Connection")
Set objRecordset = CreateObject("ADODB.Recordset")


With objConnection
     .Provider = "Microsoft.ACE.OLEDB.12.0"
     .ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
     .Open
End With


' Build the SQL cross join query.
' A cross join (or cartesian join) is used when you wish to create combination of every row from two or more tables.  All row combinations
' are included in the result.
For intTable = 1 To intNoOfItemsToCutFromStockPiece
    strSQL = strSQL & "[" & ColumnLetter(intTable + 2) & ":" & ColumnLetter(intTable + 2) & "]"
    If intTable <> intNoOfItemsToCutFromStockPiece Then strSQL = strSQL & ", "
Next


strSQL = "SELECT * FROM " & strSQL
'Debug.Print strSQL


' Run the query.
objRecordset.Open strSQL, objConnection


lngRow = 2


' Loop through the record set
Do Until objRecordset.EOF
   On Error GoTo ErrorBestCombinations
   For intField = 0 To objRecordset.Fields.Count - 1
       intTotalLengthToCutFromStockmm = intTotalLengthToCutFromStockmm + objRecordset(intField)
       strCombination = strCombination & "[" & objRecordset(intField) & "] "
   Next
   
   ' Check if the combination is within the allowable MaximumWastePercent if so then output it.
   intWaste = intStockPieceLengthmm - intTotalLengthToCutFromStockmm
   
   If intWaste < 0 Then
      ' The stock length has been exceeded
   Else
      ' Work out the waste percentage.
      vntWastePercent = Round((intWaste / intStockPieceLengthmm) * 100, 3)


      If vntWastePercent <= MaximumWastePercent Then
         ' The combination is within the acceptable wastage limit so output it.
         lngBestCombinationCount = lngBestCombinationCount + 1
         wsBestCombinations.Cells(lngRow, "A") = strCombination
         wsBestCombinations.Cells(lngRow, "B") = intTotalLengthToCutFromStockmm
         wsBestCombinations.Cells(lngRow, "C") = vntWastePercent
         
         lngRow = lngRow + 1
      End If
   End If
   
   ' Set the variables ready for the next record.
   intTotalLengthToCutFromStockmm = 0
   strCombination = ""


   objRecordset.MoveNext
   
   lngRecordCount = lngRecordCount + 1
Loop


objRecordset.Close
objConnection.Close


Set objRecordset = Nothing
Set objConnection = Nothing


' Remove the duplicate combinations.
wsBestCombinations.Columns("A:A").Select
wsBestCombinations.Range("A1:C" & LastRow(wsBestCombinations, 1)).RemoveDuplicates Columns:=1, Header:=xlYes


' Format wsBestCombinations.
wsBestCombinations.Select
wsBestCombinations.Rows("1:1").Select
Selection.Font.Bold = True
wsBestCombinations.Cells.Select
Selection.Columns.AutoFit


' Sort wsBestCombinations.
wsBestCombinations.Columns("C:C").Select
wsBestCombinations.Sort.SortFields.Clear
wsBestCombinations.Sort.SortFields.Add2 Key:=Range("C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With wsBestCombinations.Sort
    .SetRange Range("A2:C" & Trim(Str(LastRow(wsBestCombinations, 1))))
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With


' Delete the SQL Cross Join Query tables for each item to cut from the stock piece.
For intTable = intNoOfItemsToCutFromStockPiece To 1 Step -1
    objOrderWorksheet.Columns(intTable + 1).Delete Shift:=xlToLeft
Next


MsgBox "Finished analysing the best combinations." & vbCrLf & _
       Trim(Str(lngRecordCount)) & " possible combinations were analysed." & vbCrLf & _
       "Resulting in " & Trim(Str(lngBestCombinationCount)) & " possible best combinations.", _
       vbOKOnly + vbInformation, "Best Combinations Analysis Complete"


Exit Function


ErrorBestCombinations:
'Debug.Print "Error Number : "; Err.Number
'Debug.Print Err.Description
Resume Next


End Function


Public Function ColumnLetter(intColumnNumber As Integer) As String


If intColumnNumber > 26 Then
   ' 1st character: Subtract 1 to map the characters to 0-25,
   ' but you don't have to remap back to 1-26
   ' after the 'Int' operation since columns
   ' 1-26 have no prefix letter
   ' 2nd character: Subtract 1 to map the characters to 0-25,
   ' but then must remap back to 1-26 after
   ' the 'Mod' operation by adding 1 back in
   ' (included in the '65')
    ColumnLetter = Chr(Int((intColumnNumber - 1) / 26) + 64) & _
    Chr(((intColumnNumber - 1) Mod 26) + 65)
Else
   ' Columns A-Z
   ColumnLetter = Chr(intColumnNumber + 64)
End If


End Function


Public Function LastRow(objWorkSheetFindLastRow As Worksheet, intColFindLastRow As Integer) As Long


' Ensure that the column being passed is populated for all rows for the correct last row to be returned.
With objWorkSheetFindLastRow
     LastRow = .Cells(.Rows.Count, intColFindLastRow).End(xlUp).Row
End With


End Function


Public Sub PopulateOrderCombinations(objOrderWorksheet As Worksheet, objWorksheetToPopulate As Worksheet)


Dim lngBestCombinationRow As Long
Dim lngRow As Long
Dim lngPopulateRow As Long
Dim strJobNumber As String


' Delete existing data.
objWorksheetToPopulate.Select
objWorksheetToPopulate.Cells.Select
Selection.Delete Shift:=xlUp
' Create headings.
objWorksheetToPopulate.Cells(1, "A") = "Order Combinations"


lngBestCombinationRow = objOrderWorksheet.Cells(2, "C")
lngPopulateRow = 2


' Loop through the Best Combination Row column.
For lngRow = 2 To LastRow(objOrderWorksheet, 3)
    If objOrderWorksheet.Cells(lngRow, "C") = lngBestCombinationRow Then
       strJobNumber = strJobNumber & objOrderWorksheet.Cells(lngRow, "A") & ", "
    Else
       objWorksheetToPopulate.Cells(lngPopulateRow, "A") = wsBestCombinations.Cells(lngBestCombinationRow, "A") & " Job #s " & strJobNumber
       strJobNumber = objOrderWorksheet.Cells(lngRow, "A") & ", "
       lngPopulateRow = lngPopulateRow + 1
    End If
    
    lngBestCombinationRow = objOrderWorksheet.Cells(lngRow, "C")
Next


objWorksheetToPopulate.Cells(lngPopulateRow, "A") = wsBestCombinations.Cells(lngBestCombinationRow, "A") & " Job #s " & strJobNumber


' Format objWorksheetToPopulate.
objWorksheetToPopulate.Select
objWorksheetToPopulate.Rows("1:1").Select
Selection.Font.Bold = True
objWorksheetToPopulate.Cells.Select
Selection.Columns.AutoFit


End Sub


Sub TestCombinations()


' 6096mm (20ft)
' 12192mm (40ft)
' 18288mm (60ft)


Application.ScreenUpdating = False
' Change parameters to suit the required analysis.
BestCombinations wsOrder, 12192, 4, "40ft (12192mm)"
AddBestCombinationRowToOrder wsOrder
PopulateOrderCombinations wsOrder, wsOrderCombinations
Application.ScreenUpdating = True


End Sub


Option Explicit


Public Sub AddBestCombinationRowToOrder(objOrderWorksheet As Worksheet)


Dim blnCombinationMatched As Boolean
Dim intOrder As Integer
Dim lngRow As Long
Dim lngRowUndo As Long
Dim strAddComment As String
Dim strFind As String
Dim strJobNumber As String
Dim rngFoundCell As Range
Dim vntArrayBestCombination As Variant
Dim vntBestCombination As Variant


' Create header.
objOrderWorksheet.Cells(1, "C") = "Best Combination Row "


' Loop through the best combinations.
For lngRow = 2 To LastRow(wsBestCombinations, 1)
    vntBestCombination = Replace(wsBestCombinations.Cells(lngRow, "A"), "[", "")
    vntArrayBestCombination = Split(vntBestCombination, "]")
    ' Match the combinations with the order lengths.
    For intOrder = LBound(vntArrayBestCombination) To UBound(vntArrayBestCombination)
        With objOrderWorksheet
             If Trim(vntArrayBestCombination(intOrder)) <> "" Then
                Set rngFoundCell = .Columns("B").Find(What:=Trim(vntArrayBestCombination(intOrder)), After:=.Cells(2, 2), LookIn:=xlFormulas, _
                                   LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
             
                If Not rngFoundCell Is Nothing Then
                   ' Tag and highlight the order.
                   rngFoundCell.Value = rngFoundCell.Value & " X"
                   rngFoundCell.Interior.Color = vbYellow
                   objOrderWorksheet.Cells(rngFoundCell.Row, "C") = lngRow
                   strAddComment = "Combination: " & vbCrLf & wsBestCombinations.Cells(lngRow, "A") & vbCrLf & "Wastage: " & vbCrLf & _
                                    wsBestCombinations.Cells(lngRow, "C") & " %"
                   objOrderWorksheet.Cells(rngFoundCell.Row, "C").AddComment (strAddComment)
                Else
                   blnCombinationMatched = False
                End If
             End If
       End With
    Next
    
    If blnCombinationMatched = False Then
       ' Undo the Tag and highlight for the order.
       For lngRowUndo = 2 To LastRow(wsOrder, 1)
           If objOrderWorksheet.Cells(lngRowUndo, "C") = lngRow Then
              objOrderWorksheet.Cells(lngRowUndo, "B") = Replace(objOrderWorksheet.Cells(lngRowUndo, "B"), " X", "")
              objOrderWorksheet.Cells(lngRowUndo, "B").Interior.Color = xlNone
              objOrderWorksheet.Cells(lngRowUndo, "C") = ""
              objOrderWorksheet.Cells(lngRowUndo, "C").ClearComments
            End If
       Next
        
       blnCombinationMatched = True
    End If
Next


' Format objOrderWorksheet.
objOrderWorksheet.Select
objOrderWorksheet.Rows("1:1").Select
Selection.Font.Bold = True
objOrderWorksheet.Cells.Select
Selection.Columns.AutoFit


' Sort objOrderWorksheet.
objOrderWorksheet.Columns("C:C").Select
objOrderWorksheet.Sort.SortFields.Clear
objOrderWorksheet.Sort.SortFields.Add2 Key:=Range("C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With objOrderWorksheet.Sort
    .SetRange Range("A2:C" & Trim(Str(LastRow(objOrderWorksheet, 1))))
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With


End Sub


Function BestCombinations(objOrderWorksheet As Worksheet, intStockPieceLengthmm As Integer, intNoOfItemsToCutFromStockPiece As Integer, strStock As String)


' Change if you require less wastage.
Const MaximumWastePercent = 15
Dim intField As Integer
Dim intTotalLengthToCutFromStockmm As Integer
Dim intTable As Integer
Dim intWaste As Integer
Dim lngBestCombinationCount As Long
Dim lngRecordCount As Long
Dim lngRow As Long
Dim vntWastePercent As Variant
Dim objConnection As Object
Dim objRecordset As Object
Dim strCombination As String
Dim strFieldValue As String
Dim strSQL As String


' Delete existing data.
wsBestCombinations.Select
wsBestCombinations.Cells.Select
Selection.Delete Shift:=xlUp
' Create headings.
wsBestCombinations.Cells(1, "A") = "Combination"
wsBestCombinations.Cells(1, "B") = "Combination Length"
wsBestCombinations.Cells(1, "C") = "Stock " & strStock & " Wastage %"


' Create the SQL Tables for the cross join query.
objOrderWorksheet.Select
objOrderWorksheet.Columns("B").Select
Selection.Copy
For intTable = 1 To intNoOfItemsToCutFromStockPiece
    objOrderWorksheet.Columns(intTable + 2).Select
    objOrderWorksheet.Paste
Next


Set objConnection = CreateObject("ADODB.Connection")
Set objRecordset = CreateObject("ADODB.Recordset")


With objConnection
     .Provider = "Microsoft.ACE.OLEDB.12.0"
     .ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
     .Open
End With


' Build the SQL cross join query.
' A cross join (or cartesian join) is used when you wish to create combination of every row from two or more tables.  All row combinations
' are included in the result.
For intTable = 1 To intNoOfItemsToCutFromStockPiece
    strSQL = strSQL & "[" & ColumnLetter(intTable + 2) & ":" & ColumnLetter(intTable + 2) & "]"
    If intTable <> intNoOfItemsToCutFromStockPiece Then strSQL = strSQL & ", "
Next


strSQL = "SELECT * FROM " & strSQL
'Debug.Print strSQL


' Run the query.
objRecordset.Open strSQL, objConnection


lngRow = 2


' Loop through the record set
Do Until objRecordset.EOF
   On Error GoTo ErrorBestCombinations
   For intField = 0 To objRecordset.Fields.Count - 1
       intTotalLengthToCutFromStockmm = intTotalLengthToCutFromStockmm + objRecordset(intField)
       strCombination = strCombination & "[" & objRecordset(intField) & "] "
   Next
   
   ' Check if the combination is within the allowable MaximumWastePercent if so then output it.
   intWaste = intStockPieceLengthmm - intTotalLengthToCutFromStockmm
   
   If intWaste < 0 Then
      ' The stock length has been exceeded
   Else
      ' Work out the waste percentage.
      vntWastePercent = Round((intWaste / intStockPieceLengthmm) * 100, 3)


      If vntWastePercent <= MaximumWastePercent Then
         ' The combination is within the acceptable wastage limit so output it.
         lngBestCombinationCount = lngBestCombinationCount + 1
         wsBestCombinations.Cells(lngRow, "A") = strCombination
         wsBestCombinations.Cells(lngRow, "B") = intTotalLengthToCutFromStockmm
         wsBestCombinations.Cells(lngRow, "C") = vntWastePercent
         
         lngRow = lngRow + 1
      End If
   End If
   
   ' Set the variables ready for the next record.
   intTotalLengthToCutFromStockmm = 0
   strCombination = ""


   objRecordset.MoveNext
   
   lngRecordCount = lngRecordCount + 1
Loop


objRecordset.Close
objConnection.Close


Set objRecordset = Nothing
Set objConnection = Nothing


' Remove the duplicate combinations.
wsBestCombinations.Columns("A:A").Select
wsBestCombinations.Range("A1:C" & LastRow(wsBestCombinations, 1)).RemoveDuplicates Columns:=1, Header:=xlYes


' Format wsBestCombinations.
wsBestCombinations.Select
wsBestCombinations.Rows("1:1").Select
Selection.Font.Bold = True
wsBestCombinations.Cells.Select
Selection.Columns.AutoFit


' Sort wsBestCombinations.
wsBestCombinations.Columns("C:C").Select
wsBestCombinations.Sort.SortFields.Clear
wsBestCombinations.Sort.SortFields.Add2 Key:=Range("C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With wsBestCombinations.Sort
    .SetRange Range("A2:C" & Trim(Str(LastRow(wsBestCombinations, 1))))
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With


' Delete the SQL Cross Join Query tables for each item to cut from the stock piece.
For intTable = intNoOfItemsToCutFromStockPiece To 1 Step -1
    objOrderWorksheet.Columns(intTable + 1).Delete Shift:=xlToLeft
Next


MsgBox "Finished analysing the best combinations." & vbCrLf & _
       Trim(Str(lngRecordCount)) & " possible combinations were analysed." & vbCrLf & _
       "Resulting in " & Trim(Str(lngBestCombinationCount)) & " possible best combinations.", _
       vbOKOnly + vbInformation, "Best Combinations Analysis Complete"


Exit Function


ErrorBestCombinations:
'Debug.Print "Error Number : "; Err.Number
'Debug.Print Err.Description
Resume Next


End Function


Public Function ColumnLetter(intColumnNumber As Integer) As String


If intColumnNumber > 26 Then
   ' 1st character: Subtract 1 to map the characters to 0-25,
   ' but you don't have to remap back to 1-26
   ' after the 'Int' operation since columns
   ' 1-26 have no prefix letter
   ' 2nd character: Subtract 1 to map the characters to 0-25,
   ' but then must remap back to 1-26 after
   ' the 'Mod' operation by adding 1 back in
   ' (included in the '65')
    ColumnLetter = Chr(Int((intColumnNumber - 1) / 26) + 64) & _
    Chr(((intColumnNumber - 1) Mod 26) + 65)
Else
   ' Columns A-Z
   ColumnLetter = Chr(intColumnNumber + 64)
End If


End Function


Public Function LastRow(objWorkSheetFindLastRow As Worksheet, intColFindLastRow As Integer) As Long


' Ensure that the column being passed is populated for all rows for the correct last row to be returned.
With objWorkSheetFindLastRow
     LastRow = .Cells(.Rows.Count, intColFindLastRow).End(xlUp).Row
End With


End Function


Public Sub PopulateOrderCombinations(objOrderWorksheet As Worksheet, objWorksheetToPopulate As Worksheet)


Dim lngBestCombinationRow As Long
Dim lngRow As Long
Dim lngPopulateRow As Long
Dim strJobNumber As String


' Delete existing data.
objWorksheetToPopulate.Select
objWorksheetToPopulate.Cells.Select
Selection.Delete Shift:=xlUp
' Create headings.
objWorksheetToPopulate.Cells(1, "A") = "Order Combinations"


lngBestCombinationRow = objOrderWorksheet.Cells(2, "C")
lngPopulateRow = 2


' Loop through the Best Combination Row column.
For lngRow = 2 To LastRow(objOrderWorksheet, 3)
    If objOrderWorksheet.Cells(lngRow, "C") = lngBestCombinationRow Then
       strJobNumber = strJobNumber & objOrderWorksheet.Cells(lngRow, "A") & ", "
    Else
       objWorksheetToPopulate.Cells(lngPopulateRow, "A") = wsBestCombinations.Cells(lngBestCombinationRow, "A") & " Job #s " & strJobNumber
       strJobNumber = objOrderWorksheet.Cells(lngRow, "A") & ", "
       lngPopulateRow = lngPopulateRow + 1
    End If
    
    lngBestCombinationRow = objOrderWorksheet.Cells(lngRow, "C")
Next


objWorksheetToPopulate.Cells(lngPopulateRow, "A") = wsBestCombinations.Cells(lngBestCombinationRow, "A") & " Job #s " & strJobNumber


' Format objWorksheetToPopulate.
objWorksheetToPopulate.Select
objWorksheetToPopulate.Rows("1:1").Select
Selection.Font.Bold = True
objWorksheetToPopulate.Cells.Select
Selection.Columns.AutoFit


End Sub


Sub TestCombinations()


' 6096mm (20ft)
' 12192mm (40ft)
' 18288mm (60ft)


Application.ScreenUpdating = False
' Change parameters to suit the required analysis.
BestCombinations wsOrder, 12192, 4, "40ft (12192mm)"
AddBestCombinationRowToOrder wsOrder
PopulateOrderCombinations wsOrder, wsOrderCombinations
Application.ScreenUpdating = True


End Sub