Sorting and deleting

[achmidt]

Hello,

I work with 3D Autocad Inventor software, every time we finish a project, we export BOM in excel format. This BOM has all parts even the ones we don`t need, so every time I need manually delete parts that start with P and R letters in their name.
Is there any way I can automate this process using VB?

Is this doable?

Thanks,
Alex.

[tom1977]

If your names are in column D use this

Sub aa()
Dim last As Long
Dim x As Long
last = Cells(Rows.Count, "d").End(xlUp).Row
For x = last To 2 Step -1
If Cells(x, 4).Value Like "P*" Or Cells(x, 4).Value Like "R*" Then
Cells(x, 4).EntireRow.Delete
End If
Next
End Sub

[shaukat]

hello,
do you want to delete complete row which has "P" or "R" in Item, description,material,stock ?

[achmidt]

hello,
do you want to delete complete row which has "P" or "R" in Item, description,material,stock ?

Yes, delete complete row. Script above from Tom was what I needed. Thank you. Looking for how I can sort parts now.... do you know?

[achmidt]

Tom, I`m so sorry I`m a not really familiar with VBA, can you tell me where to add and how to call this sub in my spread sheet?

[achmidt]

Awesome! Thank you so much!!!

[tom1977]

press Alt + F 11 then insert module past my code and e.g. press F5

[achmidt]

Do you guys know if it is possible to sort automatically 1,2,3 etc after running "aa" sub?

[tom1977]

I am not sure I understand but if you want have numbers in column A like 1,2,3 etc try this:

Sub aaa()
Dim LastD As Long, x As Long
Dim cell As Variant
LastD = Cells(Rows.Count, "d").End(xlUp).Row

For Each cell In Range("a2:a" & LastD)
x = x + 1
cell.Value = x
Next
End Sub

[achmidt]

I am not sure I understand but if you want have numbers in column A like 1,2,3 etc try this:

Sub aaa()
Dim LastD As Long, x As Long
Dim cell As Variant
LastD = Cells(Rows.Count, "d").End(xlUp).Row

For Each cell In Range("a2:a" & LastD)
x = x + 1
cell.Value = x
Next
End Sub

Tom please see attached file. After you run the macro ( I modified it a little bit) if you look at Item column you`ll see it starts from #3. I`m wondering how to assign Item #`s so #3 becomes #1 and so on...?

[achmidt]

I am not sure I understand but if you want have numbers in column A like 1,2,3 etc try this:

Sub aaa()
Dim LastD As Long, x As Long
Dim cell As Variant
LastD = Cells(Rows.Count, "d").End(xlUp).Row

For Each cell In Range("a2:a" & LastD)
x = x + 1
cell.Value = x
Next
End Sub

sorry wrong excel spreadsheet . the one attached is correct....

[tom1977]

try this code:

Sub PARTSLISTBOM()
'
' PARTSLISTBOM Macro
' FORMAT PARTS LIST BOM
' DELETES P AND R NUMBERS
' Keyboard Shortcut: Ctrl+Shift+P
'
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("G1").Select
    Selection.NumberFormat = "General"
    ActiveCell.FormulaR1C1 = "SKID#"
    Range("H1").Select
    Selection.NumberFormat = "General"
    ActiveCell.FormulaR1C1 = "LOCATION"
    Range("H2").Select
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.ColumnWidth = 11.57
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "OLD PART"
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.RowHeight = 38.25
    Range("A1:J1").Select
    Columns("J:J").EntireColumn.AutoFit
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("B:B,C:C,E:E").Select
    Range("E2").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("F4").Select
    ActiveWindow.SmallScroll Down:=-9
    Range("B3").Select

Dim last As Long
Dim x As Long
last = Cells(Rows.Count, "e").End(xlUp).Row
For x = last To 3 Step -1
If Cells(x, 5).Value Like "P*" Or Cells(x, 5).Value Like "R*" Or Cells(x, 5).Value Like "C*" Then
Cells(x, 5).EntireRow.Delete
End If
Next
Call aaa
End Sub

Sub aaa()
Dim LastD As Long, x As Long
Dim cell As Variant
LastD = Cells(Rows.Count, "e").End(xlUp).Row

For Each cell In Range("b3:b" & LastD)
x = x + 1
cell.Value = x
Next
End Sub

[achmidt]

Genius!!! Thanks! Tom, at the risk of being a huge pain, do you mind if I`ll ask few more questions?

1. How to format cells and add borders automatically ? see test3
2. Is there any way to adjust break view so when I print it prints the entire sheet? see test3

BOM can be 10 rows long or 200 rows long.
Please see
test2.xls - after running macros and VB script
test3.xls - that what I need to be done in addition.

Thanks in advance!

[tom1977]

for borders use this:

Sub Borders()
    With Range("a1").CurrentRegion.Borders(xlEdgeLeft)
       .Weight = xlThin
    End With
    With Range("a1").CurrentRegion.Borders(xlEdgeTop)
       .Weight = xlThin
    End With
    With Range("a1").CurrentRegion.Borders(xlEdgeBottom)
        .Weight = xlThin
    End With
    With Range("a1").CurrentRegion.Borders(xlEdgeRight)
          .Weight = xlThin
    End With
    With Range("a1").CurrentRegion.Borders(xlInsideVertical)
          .Weight = xlThin
    End With
    With Range("a1").CurrentRegion.Borders(xlInsideHorizontal)
      .Weight = xlThin
    End With
      
End Sub

[achmidt]

figured out how to do break_page

Sub page_break()
'
' page_break Macro
'
    ActiveWindow.View = xlPageBreakPreview
    ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
    ActiveWindow.View = xlNormalView
End Sub