Editing BOM automatically

[achmidt]

Hello!

Need your help guys. Just wondering if this is possible (see bom1 and bom2 screen shots)

Basically what needs to be done is:

Detect material change in column F, add 2 empty rows between different materials, add WEIGHT: and do weight sum in Column G..... and so on for the entire spreadsheet.
At the very end need to See entire WEIGHT for all parts.

Any ideas? Thanks in advance!
Alex.

[6StringJazzer]

Does it need to be in that format? If you add a column for total weight for each type of material, it would be easy to do this with just formulas. If you really need this format with rows inserted then a macro will probably be easier. It would have to be set up to run anytime the worksheet changed.

Also, please see my editorial about screenshots below...

[achmidt]

Thanks,

Please take a look at the original spread sheet that Inventor spits out, I`m using macros (Ctrl+shift+F) to change it a little bit. Then if you run the macro below it will add 2 rows between materials...
My question is how to add WEIGHT: in F column and sum weight in G column???

Sub detect_mat()
Dim last As Long
Dim x As Long
last = Cells(Rows.Count, "e").End(xlUp).Row
For x = 3 To last * 4 Step 1
If Cells(x, 5).Value <> Cells(x + 1, 5).Value Then
Rows(x + 1).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    x = x + 2
    'HOW TO ADD WEIGHT?
    'HOW TO ADD SUM WEIGHT?
End If
Next
End Sub

[6StringJazzer]

Private Sub test()

   Dim x As Long
   Dim SumWeight As Double
   
   For x = 3 To 40
   
      SumWeight = SumWeight + Cells(x, 2)
   
      If Cells(x, 1).Value <> Cells(x + 1, 1).Value Then
          Rows(x + 1).Select
      
          Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
          Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
          
          'HOW TO ADD WEIGHT?
          Cells(x + 1, 6) = "WEIGHT"
          'HOW TO ADD SUM WEIGHT?
          Cells(x + 1, 7) = SumWeight
          SumWeight = 0
          
          x = x + 2
          
      End If
      
   Next

End Sub

[achmidt]

Great ! Thank you.

The other question I had, how to format cells (add borders) using vba? I guess I need to detect the lowest right corner.... how I can do that? For this particular document it is 132, but all documents are different lengths.
After downloading document please goto macros and run WEIGHTLIST1

Sub Borders()
'
'
    Range("A1:I132").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub

[snb]

Instead of

If Cells(x, 1).Value <> Cells(x + 1, 1).Value Then
 Rows(x + 1).select
      
 Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
 Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

you can use:

 
If Cells(x, 1).Value <> Cells(x + 1, 1).Value Then
  Rows(x + 1).Resize(2).Insert

But if adding a simple column:

Private Sub test()
 sn = Cells(1).CurrentRegion.Resize(, 1).Offset(, 9)
 sq = Cells(1).CurrentRegion.Offset(, 1).Resize(, 5)
 sq(1, 1) = 0
   
 For j = 3 To UBound(sn) - 1
  sq(1, 1) = sq(1, 1) + sq(j, 1)
   
  If sq(j, 5) <> sq(j + 1, 5) Then
   sn(j, 1) = sq(1, 1)
   sq(1, 1) = 0
   j = j + 1
  End If
 Next
   Cells(1, 9).Resize(UBound(sn)) = sn
End Sub

[achmidt]

Instead of

If Cells(x, 1).Value <> Cells(x + 1, 1).Value Then
 Rows(x + 1).select
      
 Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
 Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

you can use:

 
If Cells(x, 1).Value <> Cells(x + 1, 1).Value Then
  Rows(x + 1).Resize(2).Insert

Thanks snb, it does works faster now.