Pivot Table Help

[Cyclops755]

I'm using this workbook to generate a forcasted weight breakdown for heavy machinery. The idea behind it is to be able to add a new machine to the spreadsheet, select from a list which parts and options it will have equipped, and then be able to view an organized breakdown by part/option category how much the total machine weighs, and then be able to add/remove parts until the desired weight is achieved. So far the workbook break down by sheet is:
1) List of Parts and options with their respective weight data and category
2) Table of Parts/options vs. Each machine
3) A pivot table summarizing all this to provide a weight
4) Table containing all the part categories

Currently the pivot table is summarizing the entire parts/options list. What I can't find a way to do is get the table to display and summarize only the parts that are checked-off in a specific machine's column. I was hoping I could then modify the pivot table to allow me to "pivot" it to whatever machine I wished to look at, and it would display and summarize only that machines equipped parts. Either this, or have a new table auto-generated on a different sheet for each machine that's added.
Anyone have any ideas?

 

[Cyclops755]

Thanks, tried the updated code, but still no luck. It still hangs till I have to force close. I'd be happy to send you the file if that would help. PM me your email address, if that's how you'd prefer to do it.

 

[markmzz]

Thanks, tried the updated code, but still no luck. It still hangs till I have to force close. I'd be happy to send you the file if that would help. PM me your email address, if that's how you'd prefer to do it.

Look at your PM.

Markmzz

 

[markmzz]

Cyclops755,

Try the new version of the code below and tell me if it work.

Option Explicit
Sub CreateDataStorage()
    Dim myLastM, myCountM, i1, j1, cr, LastRow1, LastCol1, LastRow2, LastCol2 As Long
    Dim myFormula1, myFormula2 As String
    Dim myST(1 To 2) As Object
 
    Set myST(1) = Sheets("Combine Build List")
    Set myST(2) = Sheets("Parts List")
 
    Application.ScreenUpdating = False
 
    LastCol1 = myST(1).Cells(1, Columns.Count).End(xlToLeft).Column
    LastRow1 = myST(1).Cells(Rows.Count, 1).End(xlUp).Row
 
    myST(2).Select
 
    LastCol2 = Cells(1, Columns.Count).End(xlToLeft).Column
    LastRow2 = Cells(Rows.Count, 1).End(xlUp).Row
 
    myLastM = 2 * LastCol2 - 1
    myFormula1 = "=IF(COLUMNS(C2:C[-" & (LastCol2 - 1) & "])>COUNTIF(RC2:RC" & LastCol2 & ",""a""),"""",INDEX(R1C2:R1C" & LastCol2 & _
        ",,LARGE((RC2:RC" & LastCol2 & "=""a"")*(COLUMN(R1C2:R1C" & LastCol2 & ")-COLUMN(R1C2)+1),COLUMNS(C2:C[-" & (LastCol2 - 1) & "]))))"
    Cells(2, LastCol2 + 1).FormulaArray = myFormula1
    Cells(2, LastCol2 + 1).Copy Destination:=Range(Cells(2, LastCol2 + 2), Cells(2, myLastM))
    Range(Cells(2, LastCol2 + 1), Cells(2, myLastM)).Copy Destination:=Range(Cells(3, LastCol2 + 1), Cells(LastRow2, myLastM))
    Range(Cells(2, myLastM + 1), Cells(LastRow2, myLastM + 1)).FormulaR1C1 = "=COUNTIF(RC2:RC" & LastCol2 & ",""a"")"
 
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("Data Storage").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
 
    Sheets.Add.Name = "Data Storage"
 
    myST(1).Range(Cells(1, 1).Address, Cells(1, LastCol1).Address).Copy Destination:=Cells(1, 1)
    Cells(1, LastCol1 + 1).Value = "Machine"
    cr = 2
    For i1 = 2 To LastRow1
        myST(2).Range(Cells(i1, LastCol2 + 1).Address, Cells(i1, myLastM).Address).Copy
        Cells(cr, LastCol1 + 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
        Application.CutCopyMode = False
        myCountM = myST(2).Cells(i1, myLastM + 1).Value
 
        myST(1).Range(Cells(i1, 1).Address, Cells(i1, LastCol1).Address).Copy Destination:=Range(Cells(cr, 1), Cells(cr + myCountM - 1, LastCol1))
        cr = cr + myCountM
    Next i1
    Cells(1, 1).Select
    Range(Cells(1, 1), Cells(1, LastCol1 + 1)).EntireColumn.AutoFit
 
    myST(2).Range(Cells(1, LastCol2 + 1).Address, Cells(1, myLastM + 1).Address).EntireColumn.Delete
 
    For i1 = 1 To 2
        Set myST(i1) = Nothing
    Next i1
 
    Application.ScreenUpdating = True
End Sub

Note: I didn't received your email.

Markmzz

 

[Cyclops755]

Just tried that code, and got the same results. I just sent you the email, I apologize, I have been out of the office since our last post.

 

[markmzz]

Just tried that code, and got the same results. I just sent you the email, I apologize, I have been out of the office since our last post.

Cyclops755,

Email responded.

Markmzz

 

[Cyclops755]

Appreciate the help! Problem solved