excelvbatruthtable

Un-consolidate truth table in excel


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.

enter image description here

Here is an example of the first assembly number un-consolidated.

enter image description here

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

Solution

  • 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
    

    enter image description here