I have a truth table that has been consolidated. This truth table is used to solve for what assembly is used based on a model nomenclature. Each row represents digit in the model number.
I wish to un-consolidate it so I may have a row for each unique configuration. This is shown below.
Here is an example of the first assembly number un-consolidated.
I have unsuccessfully tried a VBA script below, but am open to all options including a cell-based formula to try and solve:
Sub UnconsolidateList()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(4) 'Change to your sheet number
Dim lastRow As Integer
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim i As Integer
For i = lastRow To 4 Step -1
Dim configs() As String
configs = Split(ws.Cells(i, 3).Value, ",")
Dim capacities() As String
capacities = Split(ws.Cells(i, 4).Value, ",")
Dim vents() As String
generation = Split(ws.Cells(i, 5).Value, ",")
Dim cases() As String
factoryops = Split(ws.Cells(i, 6).Value, ",")
Dim j As Integer, k As Integer, l As Integer, m As Integer
For j = LBound(configs) To UBound(configs)
For k = LBound(capacities) To UBound(capacities)
For l = LBound(generation) To UBound(generation)
For m = LBound(factoryops) To UBound(factoryops)
If j + k + l + m > 0 Then 'Avoid duplicating the original row
lastRow = lastRow + 1 'Increment the row number where data will be inserted
ws.Rows(lastRow & ":" & lastRow).Insert Shift:=xlDown 'Insert a new row at the end of the list
ws.Cells(lastRow - 1, "A").Copy Destination:=ws.Cells(lastRow, "A") 'Copy part no.
ws.Cells(lastRow - 1, "B").Copy Destination:=ws.Cells(lastRow, "B") 'Copy type
ws.Cells(lastRow, "C").Value2 = Trim(configs(j))
ws.Cells(lastRow, "D").Value2 = Trim(capacities(k))
ws.Cells(lastRow, "E").Value2 = Trim(generation(l))
ws.Cells(lastRow, "F").Value2 = Trim(factoryops(m))
End If
Next m
Next l
Next k
Next j
Next i
End Sub
Option Explicit
Sub Demo()
Dim i As Long, j As Long, c As Variant
Dim arrData, arrRes, iR As Long, aRow() As Variant
Dim LastRow As Long, ColCnt As Long
Dim oSht1 As Worksheet, aTxt
Dim oColl As New Collection
Set oSht1 = Sheets("Sheet1") ' modify as needed
' load source table
arrData = oSht1.Range("A1").CurrentRegion.Value
ColCnt = UBound(arrData, 2)
ReDim aRow(ColCnt - 1)
' loop through each row
For i = LBound(arrData) + 1 To UBound(arrData)
' split all items
For j = LBound(arrData, 2) To UBound(arrData, 2)
aRow(j - 1) = Split(arrData(i, j), ",")
Next j
GenerateCombinations oColl, aRow
Next i
' populate output
ReDim arrRes(1 To oColl.Count, ColCnt - 1)
iR = 0
For Each c In oColl
aTxt = Split(c, "|")
iR = iR + 1
For j = 0 To UBound(aTxt)
arrRes(iR, j) = aTxt(j)
Next
Next
' write output to new sheet
Sheets.Add
Range("A1").Resize(, ColCnt).Value = oSht1.Range("A1").Resize(, ColCnt).Value
Range("A2").Resize(iR, ColCnt).Value = arrRes
End Sub
Sub GenerateCombinations(ByRef oColl As Object, aVals() As Variant, Optional curStr As String = "", Optional colIdx As Long = 0)
Dim i As Long
' If the current index equals the length of the array
If colIdx = UBound(aVals) + 1 Then
' Debug.Print curStr
oColl.Add Mid(curStr, 2)
Exit Sub
End If
' Loop through each element in the current array and recursively call GenerateCombinations
For i = LBound(aVals(colIdx)) To UBound(aVals(colIdx))
GenerateCombinations oColl, aVals, curStr & "|" & aVals(colIdx)(i), colIdx + 1
Next i
End Sub