Can anyone figure out why one sheet acts differently that another?

P

peterrudge

New Member
Joined
Nov 6, 2011
Messages
17
I am using a macro to create a cutlist from an excel workbook. There are four sheets in the work book. There is a paste special command that runs on each sheet. On two of the sheets the command returns values only in cells that are not empty. On the other two sheets all the empty cells are filled with zeros. I can't figure out how to keep the empty cells from being filled with zeros. Can you help?

Sample Excel Doc I am trying to use macro on

Macro I am trying to execute:
Code: 
Sub CutlistCM()
'
' UnfinishedPartsCutlistCM Macro
' Unfinished parts cultist. Units CM
'

'
    
    ActiveSheet.Name = "Unfinished Parts Units CM"
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Finished Parts Units CM"
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "Faces Units CM"
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "Order Units CM"


    
'
'Change names of columns to work with move routine below
'
    Sheets("Unfinished Parts Units CM").Select
    Rows("1:1").Select
    Selection.Replace What:="PATH", Replacement:="-PART-", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="RIP", Replacement:="-RIP-", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="XCUT", Replacement:="-XCUT-", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="MATERIAL", Replacement:="-MATERIAL-", LookAt:= _
        xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="NOTES", Replacement:="-NOTES-", LookAt:= _
        xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="W_ORDER", Replacement:="-ORDER-", LookAt:= _
        xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Z_CUTLIST", Replacement:="-CUTLIST-", LookAt:= _
        xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    
'
'Move columns to correct order
'
    

    Dim aCols() As Variant, z As Long, iColCnt As Long
    Dim rFind As Range, rLook As Range
    aCols = Array("-PART-", "-RIP-", "-XCUT-", "-MATERIAL-", "-NOTES-", "-ORDER-", "-CUTLIST-")
    Set rLook = ActiveSheet.Range("1:1")
    For z = LBound(aCols) To UBound(aCols)
        Set rFind = rLook.Find(What:=aCols(z))
        If Not rFind Is Nothing Then
            If ActiveSheet.Columns(z + 1).Address <> rFind.EntireColumn.Address Then
                rFind.EntireColumn.Cut
                ActiveSheet.Columns(z + 1).Insert
            End If
        End If
    Next z
    Application.CutCopyMode = False
    
'
'Copy entire contents to all sheets
'

    Sheets("Unfinished Parts Units CM").Select
    Range("A1:BW52").Select
    Selection.Copy
    Sheets("Finished Parts Units CM").Select
    ActiveSheet.Paste
    Sheets("Faces Units CM").Select
    ActiveSheet.Paste
    Sheets("Order Units CM").Select
    ActiveSheet.Paste
    


    
'
'Filter the rows we want on each sheet
'

    Sheets("Unfinished Parts Units CM").Select
    Cells.Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$BZ$132").AutoFilter Field:=7, Criteria1:="Yes"
    ActiveSheet.Range("$A$1:$BZ$132").AutoFilter Field:=4, Criteria1:= _
        "=1/4 Int Material", Operator:=xlOr, Criteria2:="=3/4 Int Material"
        
    Sheets("Finished Parts Units CM").Select
    Cells.Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$BZ$132").AutoFilter Field:=7, Criteria1:="Yes"
    ActiveSheet.Range("$A$1:$BZ$132").AutoFilter Field:=4, Criteria1:= _
        "=1/4 Ext Material", Operator:=xlOr, Criteria2:="=3/4 Ext Material"
        
    Sheets("Faces Units CM").Select
    Cells.Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$BZ$132").AutoFilter Field:=7, Criteria1:="Yes"
    ActiveSheet.Range("$A$1:$BZ$132").AutoFilter Field:=4, Criteria1:= _
        "=Faces"
        
    Sheets("Order Units CM").Select
    Cells.Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$BZ$132").AutoFilter Field:=6, Criteria1:= _
        "=Yes"
        
'
'Delete hidden rows and columns
'
Sheets("Unfinished Parts Units CM").Select
For lp = 256 To 1 Step -1 'loop through all columns
If Columns(lp).EntireColumn.Hidden = True Then Columns(lp).EntireColumn.Delete Else
Next

For lp = 65536 To 1 Step -1 'loop through all rows
If Rows(lp).EntireRow.Hidden = True Then Rows(lp).EntireRow.Delete Else
Next

Sheets("Finished Parts Units CM").Select
For lp = 256 To 1 Step -1 'loop through all columns
If Columns(lp).EntireColumn.Hidden = True Then Columns(lp).EntireColumn.Delete Else
Next

For lp = 65536 To 1 Step -1 'loop through all rows
If Rows(lp).EntireRow.Hidden = True Then Rows(lp).EntireRow.Delete Else
Next

Sheets("Faces Units CM").Select
For lp = 256 To 1 Step -1 'loop through all columns
If Columns(lp).EntireColumn.Hidden = True Then Columns(lp).EntireColumn.Delete Else
Next

For lp = 65536 To 1 Step -1 'loop through all rows
If Rows(lp).EntireRow.Hidden = True Then Rows(lp).EntireRow.Delete Else
Next

Sheets("Order Units CM").Select
For lp = 256 To 1 Step -1 'loop through all columns
If Columns(lp).EntireColumn.Hidden = True Then Columns(lp).EntireColumn.Delete Else
Next

For lp = 65536 To 1 Step -1 'loop through all rows
If Rows(lp).EntireRow.Hidden = True Then Rows(lp).EntireRow.Delete Else
Next

'
'Delete columns we don't need
'

Sheets("Unfinished Parts Units CM").Select
Columns("E:BZ").Select
    Selection.Delete Shift:=xlToLeft
    
Sheets("Finished Parts Units CM").Select
Columns("E:BZ").Select
    Selection.Delete Shift:=xlToLeft
    
Sheets("Faces Units CM").Select
Columns("F:BZ").Select
    Selection.Delete Shift:=xlToLeft
    
Sheets("Order Units CM").Select
Columns("F:BZ").Select
    Selection.Delete Shift:=xlToLeft
    
'
'Change values to CM
'
Sheets("Unfinished Parts Units CM").Select
 Range("H1").Select
 ActiveCell.FormulaR1C1 = "2.54"
    Range("H1").Select
    Selection.Copy
    Range("B2:C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=-3
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
        SkipBlanks:=True, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "0.0"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = ""
    
Sheets("Finished Parts Units CM").Select
 Range("H1").Select
 ActiveCell.FormulaR1C1 = "2.54"
    Range("H1").Select
    Selection.Copy
    Range("B2:C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=-3
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
        SkipBlanks:=True, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "0.0"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = ""
    
Sheets("Faces Units CM").Select
 Range("H1").Select
 ActiveCell.FormulaR1C1 = "2.54"
    Range("H1").Select
    Selection.Copy
    Range("B2:C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=-3
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
        SkipBlanks:=True, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "0.0"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = ""
    
Sheets("Order Units CM").Select
 Range("H1").Select
 ActiveCell.FormulaR1C1 = "2.54"
    Range("H1").Select
    Selection.Copy
    Range("B2:C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=-3
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
        SkipBlanks:=True, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "0.0"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = ""
    
'
'Sort by material, rip, then xcut
'

Sheets("Unfinished Parts Units CM").Select
 Range("A1:G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort.SortFields.Add Key _
        :=Range("D2:D132"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort.SortFields.Add Key _
        :=Range("B2:B132"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort.SortFields.Add Key _
        :=Range("C2:C132"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort
        .SetRange Range("A1:G132")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
Sheets("Finished Parts Units CM").Select
 Range("A1:G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort.SortFields.Add Key _
        :=Range("D2:D132"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort.SortFields.Add Key _
        :=Range("B2:B132"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort.SortFields.Add Key _
        :=Range("C2:C132"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort
        .SetRange Range("A1:G132")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Sheets("Faces Units CM").Select
 Range("A1:G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort.SortFields.Add Key _
        :=Range("D2:D132"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort.SortFields.Add Key _
        :=Range("B2:B132"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort.SortFields.Add Key _
        :=Range("C2:C132"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort
        .SetRange Range("A1:G132")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Sheets("Order Units CM").Select
 Range("A1:G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort.SortFields.Add Key _
        :=Range("D2:D132"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort.SortFields.Add Key _
        :=Range("B2:B132"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort.SortFields.Add Key _
        :=Range("C2:C132"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Unfinished Parts Units CM").Sort
        .SetRange Range("A1:G132")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Call BlankRowUnfin
Call BlankRowFin
Call SumRIPRowsUnFin
Call SumRIPRowsFin
Call Formatting


End Sub

    
'
'Add a blank row when the RIP value changes
'

Sub BlankRowUnfin()
Sheets("Unfinished Parts Units CM").Select
    Dim lRow As Long
    For lRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row To 2 Step -1
        If Cells(lRow, "B") <> Cells(lRow - 1, "B") Then Rows(lRow).EntireRow.Insert
    Next lRow
End Sub

Sub BlankRowFin()
Sheets("Finished Parts Units CM").Select
    Dim lRow As Long
    For lRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row To 2 Step -1
        If Cells(lRow, "B") <> Cells(lRow - 1, "B") Then Rows(lRow).EntireRow.Insert
    Next lRow
End Sub

Sub SumRIPRowsUnFin()
    
'
'Sum RIP rows
'
Sheets("Unfinished Parts Units CM").Select
Dim StartRow As Integer
Dim EndRow As Integer

StartRow = 3
EndRow = Range("D65536").End(xlUp).Offset(1, 0).Row
For i = StartRow To EndRow
If Cells(i, "C") = "" And i > StartRow Then
Cells(i, "C").Formula = "=SUM(C" & StartRow & ":C" & i - 1 & ")/244"
Cells(i, "D").Formula = "Rips"
StartRow = i + 1
End If
Next

End Sub

Sub SumRIPRowsFin()
Sheets("Finished Parts Units CM").Select
Dim StartRow As Integer
Dim EndRow As Integer

StartRow = 3
EndRow = Range("D65536").End(xlUp).Offset(1, 0).Row
For i = StartRow To EndRow
If Cells(i, "C") = "" And i > StartRow Then
Cells(i, "C").Formula = "=SUM(C" & StartRow & ":C" & i - 1 & ")/244"
Cells(i, "D").Formula = "Rips"
StartRow = i + 1
End If
Next

End Sub


Sub Formatting()


'
'Remove extra words in PART column and format RIP and XCUT for easier reading
'
Sheets("Unfinished Parts Units CM").Select
    Cells.Select
    Selection.Replace What:="Model*/WorkPort*/", Replacement:="", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("A1").Select
    Columns("A:A").ColumnWidth = 19.43
    Columns("B:C").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
Sheets("Finished Parts Units CM").Select
    Cells.Select
    Selection.Replace What:="Model*/WorkPort*/", Replacement:="", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("A1").Select
    Columns("A:A").ColumnWidth = 19.43
    Columns("B:C").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
Sheets("Faces Units CM").Select
    Cells.Select
    Selection.Replace What:="Model*/WorkPort*/", Replacement:="", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("A1").Select
    Columns("A:A").ColumnWidth = 19.43
    Columns("B:C").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
Sheets("Order Units CM").Select
    Cells.Select
    Selection.Replace What:="Model*/WorkPort*/", Replacement:="", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("A1").Select
    Columns("A:A").ColumnWidth = 19.43
    Columns("B:C").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    
'
'Add some lines to help highlight rips totals
'
Sheets("Unfinished Parts Units CM").Select
Cells.Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="Rips", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlBottom)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    
    
Sheets("Finished Parts Units CM").Select
Cells.Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="Rips", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlBottom)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    

'
'Change page settings to show file name and sheet name as headers / footers. Printer header on all pages
'
Sheets("Unfinished Parts Units CM").Select
 With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
    End With
    With ActiveSheet.PageSetup
        .CenterHeader = "&F"
        .CenterFooter = "&A"
    End With
    
Sheets("Finished Parts Units CM").Select
 With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
    End With
    With ActiveSheet.PageSetup
        .CenterHeader = "&F"
        .CenterFooter = "&A"
    End With
    
Sheets("Faces Units CM").Select
 With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
    End With
    With ActiveSheet.PageSetup
        .CenterHeader = "&F"
        .CenterFooter = "&A"
    End With
    
Sheets("Order Units CM").Select
 With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
    End With
    With ActiveSheet.PageSetup
        .CenterHeader = "&F"
        .CenterFooter = "&A"
    End With
    
End Sub
 
Sort by date Sort by votes
First let me say I really appreciate your help on this. The 2 sample outputs I attached in post #8 are both from the sample csv file attached to post #6.
 
Upvote 0

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
The file you posted in post #6 is giving different results in column A because the "text strings" are different and your macro does not account for them.

Anway, heres the original macro back with a different method of checking for "no data" on the sheets "Unfinished Parts Units CM" and "Finished Parts Units CM":
Rich (BB code): 
Option Explicit

Sub CutlistCM2()
Dim aCols() As Variant, Old() As Variant, BlankRNG As Range
Dim StartRow As Long, EndRow As Long, z As Long
Dim rFind As Range, rLook As Range, wsData As Worksheet, ws As Worksheet

Application.ScreenUpdating = False

    Old = Array("PATH", "RIP", "XCUT", "MATERIAL", "NOTES", "W_ORDER", "Z_CUTLIST")
    aCols = Array("-PART-", "-RIP-", "-XCUT-", "-MATERIAL-", "-NOTES-", "-ORDER-", "-CUTLIST-")
        
    Set wsData = ActiveSheet
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Unfinished Parts Units CM"
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Finished Parts Units CM"
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Faces Units CM"
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Order Units CM"
    
'Change names of columns to work with move routine below
    With wsData
        For z = LBound(Old) To UBound(Old)
            .Rows("1:1").Replace What:=Old(z), Replacement:=aCols(z), _
                LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
                SearchFormat:=False, ReplaceFormat:=False
        Next z

    'Move columns to correct order
        Set rLook = .Range("1:1")
        For z = LBound(aCols) To UBound(aCols)
            Set rFind = rLook.Find(What:=aCols(z), LookIn:=xlValues, LookAt:=xlWhole)
            If Not rFind Is Nothing Then
                If .Columns(z + 1).Address <> rFind.EntireColumn.Address Then
                    rFind.EntireColumn.Cut
                    .Columns(z + 1).Insert
                End If
            End If
        Next z
        Application.CutCopyMode = False
        
    'correct values in CM
        .Range("H1") = "2.54"
        .Range("H1").Copy
        With .Range("B:C")
            .PasteSpecial xlPasteAll, Operation:=xlMultiply, _
                SkipBlanks:=True, Transpose:=False
            .NumberFormat = "0.0"
        End With
        .Range("H1") = ""
        
    'Filter from the original datasheet
        .Rows(1).AutoFilter
      'Filter for UNFINISHED PARTS
        .Rows(1).AutoFilter Field:=7, Criteria1:="Yes"
        .Rows(1).AutoFilter Field:=4, Criteria1:="=1/4 Int Material", _
                      Operator:=xlOr, Criteria2:="=3/4 Int Material"
        .Range("A1:D52").Copy Sheets("Unfinished Parts Units CM").Range("A1")
        .ShowAllData
        
      'Filter for FINISHED PARTS
        .Rows(1).AutoFilter Field:=7, Criteria1:="Yes"
        .Rows(1).AutoFilter Field:=4, Criteria1:="=1/4 Int Material", _
                      Operator:=xlOr, Criteria2:="=3/4 Int Material"
        .Range("A1:D52").Copy Sheets("Finished Parts Units CM").Range("A1")
        .ShowAllData
        
      'Filter for FACES UNITS
        .Rows(1).AutoFilter Field:=7, Criteria1:="Yes"
        .Rows(1).AutoFilter Field:=4, Criteria1:="=Faces"
        .Range("A1:E52").Copy Sheets("Faces Units CM").Range("A1")
        .ShowAllData
        
      'Filter for ORDER UNITS
        .Rows(1).AutoFilter Field:=6, Criteria1:="=Yes"
        .Range("A1:E52").Copy Sheets("Order Units CM").Range("A1")
        .AutoFilterMode = False
    End With
    
'Sort by material, rip, then xcut, then remove extra text, set print settings
    For Each ws In Sheets(Array("Unfinished Parts Units CM", _
            "Finished Parts Units CM", "Faces Units CM", "Order Units CM"))
        With ws
            .Range("A:G").Sort Key1:=.Range("D2"), Order1:=xlAscending, _
                      Key2:=.Range("B2"), Order2:=xlAscending, _
                      Key3:=.Range("C2"), Order3:=xlAscending, _
                      Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
                      Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
                      DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
        
            .Cells.Replace What:="Model*/WorkPort*/", Replacement:="", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            .Columns.AutoFit
            .Columns("B:C").HorizontalAlignment = xlLeft
            
            .PageSetup.PrintTitleRows = "$1:$1"
            .PageSetup.CenterHeader = "&F"
            .PageSetup.CenterFooter = "&A"
        End With
    Next ws
    
    For Each ws In Sheets(Array("Unfinished Parts Units CM", "Finished Parts Units CM"))
        With ws
            For z = .Cells(.Cells.Rows.Count, "B").End(xlUp).Row To 3 Step -1
                If .Cells(z, "B") <> .Cells(z - 1, "B") Then .Rows(z).EntireRow.Insert
            Next z
            .Columns.AutoFit
            
            StartRow = 2
            EndRow = .Range("D" & .Rows.Count).End(xlUp).Row + 1
            For z = StartRow To EndRow
                If .Cells(z, "C") = "" And z > StartRow Then
                    .Cells(z, "C").Formula = "=SUM(C" & StartRow & ":C" & z - 1 & ")/244"
                    StartRow = z + 1
                End If
            Next z
            
            On Error Resume Next
            Set BlankRNG = .Range("D2:D" & EndRow).SpecialCells(xlBlanks)
            If Not BlankRNG Is Nothing Then
                With BlankRNG
                    .Borders(xlTop).Weight = xlThin
                    .Borders(xlBottom).Weight = xlThin
                    .Value = "Rips"
                End With
            End If
        End With
    Next ws

Application.ScreenUpdating = True
If MsgBox("Done... do you wish to delete the original raw data sheet?", vbYesNo, _
    "Delete raw data file") = vbYes Then
        Application.DisplayAlerts = False
        wsData.Delete
End If

End Sub


Excel Workbook
ABCDE
1-PART--RIP--XCUT--MATERIAL-
2Model/NorthWall/1/nailer10.084.33/4 Int Material
3Model/NorthWall/1/nailer10.084.33/4 Int Material
4Model/NorthWall/2/nailer10.084.33/4 Int Material
5Model/NorthWall/2/nailer10.084.33/4 Int Material
61.4Rips
7Model/NorthWall/1/bottom58.284.33/4 Int Material
8Model/NorthWall/1/top58.284.33/4 Int Material
9Model/NorthWall/2/bottom58.284.33/4 Int Material
10Model/NorthWall/2/top58.284.33/4 Int Material
11Model/NorthWall/1/right side58.2226.03/4 Int Material
12Model/NorthWall/1/left side58.2226.03/4 Int Material
13Model/NorthWall/2/right side58.2226.03/4 Int Material
14Model/NorthWall/2/left side58.2226.03/4 Int Material
155.0869Rips
16
Unfinished Parts Units CM
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Macro to scroll to the last coloured cell in a spreadsheet
Replies
4
Views
394
Joe4
Joe4
E
  • Solved
A little VBA/Macro code adjustment
Replies
3
Views
273
rollis13
rollis13
S
  • Question Question
Help with combining 2 macros into 1
Replies
8
Views
263
MARK858
MARK858
J
  • Question Question
Rename a Sheet
Replies
2
Views
361
Peter_SSs
Peter_SSs
H
  • Solved
Sorting and Deleting VBA for large file
2
Replies
16
Views
776
heathball
H

Forum statistics

Threads
1,223,886
Messages
6,175,195
Members
452,616
Latest member
intern444

Share this page

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