Summarising Multiple BOM Tables into one - best solution?

jozzy

New Member
Joined
May 20, 2009
Messages
21
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).

:eek: 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 :p)

BOM1 (Worksheet 1)
PartLengthQuantity
P10118002
P10115001
P1106006
P1206006

<tbody>
</tbody>

BOM2 (Worksheet 2)
PartLengthQuantity
P10118005
P11060010
P12060010

<tbody>
</tbody>

BOM3 (Worksheet 3)
PartLengthQuantity
P10118001
P10119001
P1106004
P1206004

<tbody>
</tbody>

Summmary (Worksheet 4) - EXAMPLE
PartLengthQuantity
P10119001
P10118008
P10115001
P11060020
P12060020

<tbody>
</tbody>


Should you require more info please feel free to ask.


Cheers,
Sean

Excel 2010
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
See if this works for you.
Code:
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
 
Last edited:
Upvote 0
jozzy,

Sample raw data worksheets:


Excel 2007
ABC
1PartLengthQuantity
2P10118002
3P10115001
4P1106006
5P1206006
6
BOM1



Excel 2007
ABC
1PartLengthQuantity
2P10118005
3P11060010
4P12060010
5
BOM2



Excel 2007
ABC
1PartLengthQuantity
2P10118001
3P10119001
4P1106004
5P1206004
6
BOM3


After the macro in a new worksheet Summary:


Excel 2007
ABC
1PartLengthQuantity
2P10119001
3P10118008
4P10115001
5P11060020
6P12060020
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.

Code:
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.
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
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!
 
Upvote 0

Forum statistics

Threads
1,214,584
Messages
6,120,384
Members
448,956
Latest member
JPav

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top