Summarising Multiple BOM Tables into one - best solution?

[jozzy]

G'day folks,

So I am looking for multiple/best solution(s) to summarise/consolidate multiple tables into one. These tables are Bill of Materials (BOM's), on each worksheet will be a table summarising the materials required for each product assembly. The tables are made up of Part Numbers, Cutting Length and Quantity the end result should reflect the results as per my example below (Summary - worksheet 4).

Ideally the solution should be dynamic - if one table is updated the summary would reflect this update.

I have tried going down the Pivot table route and this to me is the most logical solution but I seem to be running into problems with the Pivot Table summarising my lengths, this is not what I require as each Part must be cut to the specified length. (This may be the result of me not driving a Pivot Table properly )

BOM1 (Worksheet 1)
[TABLE="class: grid, width: 192"]
<tbody>[TR]
[TD="width: 64"]Part[/TD]
[TD="width: 64"]Length[/TD]
[TD="width: 64"]Quantity[/TD]
[/TR]
[TR]
[TD]P101[/TD]
[TD="align: right"]1800[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD]P101[/TD]
[TD="align: right"]1500[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD]P110[/TD]
[TD="align: right"]600[/TD]
[TD="align: right"]6[/TD]
[/TR]
[TR]
[TD]P120[/TD]
[TD="align: right"]600[/TD]
[TD="align: right"]6[/TD]
[/TR]
</tbody>[/TABLE]

BOM2 (Worksheet 2)
[TABLE="class: grid, width: 192"]
<tbody>[TR]
[TD="width: 64"]Part[/TD]
[TD="width: 64"]Length[/TD]
[TD="width: 64"]Quantity[/TD]
[/TR]
[TR]
[TD]P101[/TD]
[TD="align: right"]1800[/TD]
[TD="align: right"]5[/TD]
[/TR]
[TR]
[TD]P110[/TD]
[TD="align: right"]600[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]P120[/TD]
[TD="align: right"]600[/TD]
[TD="align: right"]10[/TD]
[/TR]
</tbody>[/TABLE]

BOM3 (Worksheet 3)
[TABLE="class: grid, width: 192"]
<tbody>[TR]
[TD="width: 64"]Part[/TD]
[TD="width: 64"]Length[/TD]
[TD="width: 64"]Quantity[/TD]
[/TR]
[TR]
[TD]P101[/TD]
[TD="align: right"]1800[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD]P101[/TD]
[TD="align: right"]1900[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD]P110[/TD]
[TD="align: right"]600[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]P120[/TD]
[TD="align: right"]600[/TD]
[TD="align: right"]4[/TD]
[/TR]
</tbody>[/TABLE]

Summmary (Worksheet 4) - EXAMPLE
[TABLE="class: grid, width: 192"]
<tbody>[TR]
[TD="width: 64"]Part[/TD]
[TD="width: 64"]Length[/TD]
[TD="width: 64"]Quantity[/TD]
[/TR]
[TR]
[TD]P101[/TD]
[TD="align: right"]1900[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD]P101[/TD]
[TD="align: right"]1800[/TD]
[TD="align: right"]8[/TD]
[/TR]
[TR]
[TD]P101[/TD]
[TD="align: right"]1500[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD]P110[/TD]
[TD="align: right"]600[/TD]
[TD="align: right"]20[/TD]
[/TR]
[TR]
[TD]P120[/TD]
[TD="align: right"]600[/TD]
[TD="align: right"]20[/TD]
[/TR]
</tbody>[/TABLE]


Should you require more info please feel free to ask.


Cheers,
Sean

Excel 2010

 

[JLGWhiz]

See if this works for you.

Sub consBOM()
Dim sh As Worksheet, sSh As Worksheet, i As Long, lr As Long, fLoc As Range, c As Range, fAdr As String
Set sSh = Sheets("Summary")
For Each sh In ThisWorkbook.Sheets
    If sh.Name <> sSh.Name Then
        lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To lr
            sSh.Cells(Rows.Count, 4).End(xlUp)(2) = sh.Cells(i, 1).Value & "-" & sh.Cells(i, 2).Value
        Next
    End If
Next
sSh.Range("D1", sSh.Cells(Rows.Count, 4).End(xlUp)).AdvancedFilter xlFilterCopy, , sSh.Range("E1"), True
For Each c In sSh.Range("E2", sSh.Cells(Rows.Count, 5).End(xlUp))
    sSh.Range("A" & c.Row) = Left(c.Value, InStr(c.Value, "-") - 1)
    sSh.Range("B" & c.Row) = Right(c.Value, Len(c) - InStr(c.Value, "-"))
Next
For Each sh In ThisWorkbook.Sheets
    If sh.Name <> sSh.Name Then
        For i = 2 To sSh.Cells(Rows.Count, 1).End(xlUp).Row
            Set fLoc = sh.Range("A:A").Find(sSh.Cells(i, 1).Value, , xlValues, xlWhole)
                If Not fLoc Is Nothing Then
                    fAdr = fLoc.Address
                    Do
                    If sSh.Cells(i, 2) = fLoc.Offset(0, 1) Then
                        sSh.Cells(i, 3) = sSh.Cells(i, 3).Value + fLoc.Offset(0, 2).Value
                    End If
                    Set fLoc = sh.Range("A:A").FindNext(fLoc)
                    Loop While fLoc.Address <> fAdr
                End If
        Next
    End If
Next
sSh.Columns("D:E").ClearContents
End Sub

 

[hiker95]

jozzy,

Sample raw data worksheets:

Excel 2007
	A	B	C
1	Part	Length	Quantity
2	P101	1800	2
3	P101	1500	1
4	P110	600	6
5	P120	600	6
6
BOM1

Excel 2007
	A	B	C
1	Part	Length	Quantity
2	P101	1800	5
3	P110	600	10
4	P120	600	10
5
BOM2

Excel 2007
	A	B	C
1	Part	Length	Quantity
2	P101	1800	1
3	P101	1900	1
4	P110	600	4
5	P120	600	4
6
BOM3

After the macro in a new worksheet Summary:

Excel 2007
	A	B	C
1	Part	Length	Quantity
2	P101	1900	1
3	P101	1800	8
4	P101	1500	1
5	P110	600	20
6	P120	600	20
7
Summary

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub SummariseBOMs()
' hiker95, 08/24/2014, ME801072
Dim wb As Worksheet, ws As Worksheet
Dim r As Long, lr As Long, n As Long, nr As Long
Application.ScreenUpdating = False
If Not Evaluate("ISREF(Summary!A1)") Then Worksheets.Add().Name = "Summary"
Set ws = Sheets("Summary")
With ws
  .UsedRange.Clear
  With .Cells(1, 1).Resize(, 3)
    .Value = Array("Part", "Length", "Quantity")
    .Font.Bold = True
  End With
End With
For Each wb In ThisWorkbook.Worksheets
  If wb.Name <> "Summary" Then
    With wb
      lr = .Cells(Rows.Count, 1).End(xlUp).Row
      nr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
      .Range("A2:C" & lr).Copy Destination:=ws.Range("A" & nr)
      Application.CutCopyMode = False
    End With
  End If
Next wb
With ws
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  .Range("A2:C" & lr).Sort key1:=Range("A2"), order1:=1, key2:=Range("B2"), order2:=2
  With .Range("D2:D" & lr)
    .FormulaR1C1 = "=RC[-3]&RC[-2]"
    .Value = .Value
  End With
  For r = 2 To lr
    n = Application.CountIf(.Columns(4), .Cells(r, 4).Value)
    If n > 1 Then
      .Range("C" & r).Value = Evaluate("=Sum(C" & r & ":C" & r + n - 1 & ")")
      .Range("A" & r + 1 & ":C" & r + 1 + n - 2).ClearContents
    End If
    r = r + n - 1
  Next r
  .Columns(4).ClearContents
  .Range("A2:C" & lr).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
  .Columns(1).Resize(, 3).AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the SummariseBOMs macro.

 

[jozzy]

See if this works for you.

Hey JLGWhiz,

Thanks for the prompt response unfortunately this isn't exactly what I am looking for. I still require a table form to list Part No., Length and Quantity. Essentially taking all the information from each worksheet, checking if the Part No. and Length match and adding these quantities together.

I think Hiker95 maybe be onto the right track.


Cheers,

Sean

 

[jozzy]

Hiker95,

Thanks for this! Works perfectly. I just need to try and get my head around what is happening in the code so that I can gain more understanding as to what each part is doing and adopt it to my worksheets.
If you have time to explain (as I am no VBA guru) it would be much appreciated.


Cheers ,

Sean

 

[hiker95]

jozzy,

Thanks for this! Works perfectly.

Thanks for the feedback.

You are very welcome. Glad I could help.

If you have time to explain (as I am no VBA guru) it would be much appreciated.

I would be happy to, but????

and adopt it to my worksheets

It is always best to display your actual raw data worksheet(s), and, the results that you are looking for. This way we can usually find a solution on the first go.

If you have not given us screenshots of the actual worksheet(s) setup, then:

First things first.

1. Can we see screenshots of the actual worksheets?

2. And, can we see a screenshot (manually formatted by you) for the results that you are looking for?

Then I would be happy to put comments in the new macro code, so that you can understand what I have done.


I will be going fly fishing in a little while, and, will be back later in the day.

Hope to see the new screenshots by the time I get back.

 

[jozzy]

jozzy,

Hope to see the new screenshots by the time I get back.

This I can do, as we have a bit of a time difference between us.............there may be a little delay.

Enjoy the fishing!


Sean.

 

[jozzy]

So it has been a little while since I started working on this and I have now got around to producing some images to better demonstrate what is required. The below images depict three different assembly sheets consisting of various dimensions and finishes. These data from each assembly / bill of materials (BOM's) require grouping into one single summary sheet.

Assembly (1): https://onedrive.live.com/redir?res...authkey=!ANetls_LMYoGuSE&v=3&ithint=photo,JPG
Assembly (2): https://onedrive.live.com/redir?res...authkey=!ACgbMCJh82cG-AQ&v=3&ithint=photo,JPG
Assembly (3): https://onedrive.live.com/redir?res...authkey=!AJBzowCEKruAkys&v=3&ithint=photo,JPG
Summary: https://onedrive.live.com/redir?res...authkey=!ANuiSuAVpXMaPC4&v=3&ithint=photo,JPG


The summary sheet should collate all the data from each assembly and group similar item Descriptions, Dimensions and Quantities together to produce a summary sheet.

Each assembly sheet will contain the following cells.
A12:A33 Item Description.
B12:B33 Height.
C12:C33 Length.
D12:D33 Quantity.

A user may be required to add or remove additional Assembly sheets at a later stage, so the ability to recalculate the summary is required.

 

[hiker95]

jozzy,

The 4 links are not working.

It would appear that they are JPG files.

You are posting pictures/graphics. This means that if this was a problem where one needed to use your data, anyone trying to help you would have to enter the data manually. That makes no sense.

The screenshots that you posted in your reply #1, should work again for the new data????

If not:

You can upload your workbook to Box Net,

sensitive data changed

mark the workbook for sharing

and provide us with a link to your workbook.

 

[jozzy]

Hmmm strange links work for me :-S

Thanks for the tip though, I shall just upload a sample of the workbook and make everyone's life much easier

Cheers!