Error 438 - office 2010

BarneyLTD

New Member
Joined
Sep 27, 2017
Messages
27
Hi guys, I have a sheet that creates a stocklist from a master list and it works fine for me (Office 365) but fails on a machine running Office 2010. Any ideas? had a search but none seemed to match this problem. Code below...

Problem code:

VBA Code:
 ActiveWorkbook.Worksheets("CD").AutoFilter.Sort.SortFields.Clear ' runtime error 438 on office 2010

    ActiveWorkbook.Worksheets("CD").AutoFilter.Sort.SortFields.Add2 Key:=Range( _

        "S:S"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

        xlSortNormal

    With ActiveWorkbook.Worksheets("CD").AutoFilter.Sort

        .Header = xlYes

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With


Full code

VBA Code:
Sub CreateMasterList()
'
' CreateMasterList Macro
'
' CD LIST
' Clear Formatting & clear empty cells
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
    Sheets("CD").Select
    ActiveWindow.Zoom = 90
    Range("D:D,J:L,S:S").ClearFormats
    Range("A1").End(xlDown).Offset(1, 0).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ' EXCEPTIONS & CARD COLUMNS
    Columns("A:A").EntireColumn.AutoFit
    Range("T1").FormulaR1C1 = "EXC"
    Range("U1").FormulaR1C1 = "ISCARD"
    'check for filter, turn on if none exists
    If Not ActiveSheet.AutoFilterMode Then
    ActiveSheet.Range("A1").AutoFilter
    End If
    ' Best Sellers
    ActiveWorkbook.Worksheets("CD").AutoFilter.Sort.SortFields.Clear ' runtime error 438 on office 2010
    ActiveWorkbook.Worksheets("CD").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "S:S"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("CD").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A:$U").AutoFilter Field:=19, Criteria1:="<5", _
        Operator:=xlAnd
    Range("S2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    ActiveSheet.Range("$A:$U").AutoFilter Field:=19
    ActiveWorkbook.Worksheets("CD").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("CD").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "S:S"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("CD").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A:$U").AutoFilter Field:=19, Criteria1:=">=5" _
        , Operator:=xlAnd
    Range("S2").Select
    ActiveCell.FormulaR1C1 = "BEST SELLER"
    'Range("S3").FillDown
    ActiveCell.autofill Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1))
    ActiveSheet.Range("$A:$U").AutoFilter Field:=19
    Application.CutCopyMode = False
    ' Exceptions
    Range("T2").FormulaR1C1 = "=VLOOKUP(RC1,'Exceptions'!C1:C6,6,0)"
    Range("T2").autofill Destination:=Range("T2:T" & Range("A" & Rows.Count).End(xlUp).Row)
    'Selection.autofill Destination:=Range("T2:T158193")
    'ActiveCell.autofill Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1))
    Range("T2").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("CD").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("CD").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "T:T"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("CD").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A:$U").AutoFilter Field:=20, Criteria1:="=Y", _
        Operator:=xlAnd
    Range("$A2:$U2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.Range("$A:$U").AutoFilter Field:=20
    Columns("G:I").Select
    Selection.Delete Shift:=xlToLeft
    Columns("J:O").Select
    Selection.Delete Shift:=xlToLeft
    ' Is Card
    Range("L2").FormulaR1C1 = "=VLOOKUP(RC1,'Cardboard CD'!C1:C5,5,0)"
    Range("L2").autofill Destination:=Range("L2:L" & Range("A" & Rows.Count).End(xlUp).Row)
    'Selection.autofill Destination:=Range("L2:L148446")
    Range("L2").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("CD").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("CD").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "L:L"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("CD").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A:$L").AutoFilter Field:=12, Criteria1:="=Y", _
        Operator:=xlAnd
    Range("A1:L1").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("A1").Select
    If Not ActiveSheet.AutoFilterMode Then
    ActiveSheet.Range("A1").AutoFilter
    End If
    ActiveWindow.Zoom = 90
    ActiveSheet.Name = "CD_CARD"
    Columns("K:L").Delete Shift:=xlToLeft
    Range("A1").Select
    Range("G1").FormulaR1C1 = "ASIS"
    Range("H1").FormulaR1C1 = "PARTIAL"
    Range("I1").FormulaR1C1 = "FULL"
    Range("C2").FormulaR1C1 = "=VLOOKUP(RC1,'Cardboard CD'!C1:C5,4,0)"
    Range("C2").autofill Destination:=Range("C2:C" & Range("A" & Rows.Count).End(xlUp).Row)
    Range("C2").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("L2").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("C:J").EntireColumn.AutoFit
    Range("A1").Select
    ' Delete Card from CD
    Sheets("CD").Select
    Application.CutCopyMode = False
    Range("A2:L2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.EntireRow.Delete
    ActiveSheet.Range("$A$1:$L$142962").AutoFilter Field:=12
    Columns("K:L").Delete Shift:=xlToLeft
    Range("A1").Select
    Range("G1").FormulaR1C1 = "ASIS"
    Range("H1").FormulaR1C1 = "PARTIAL"
    Range("I1").FormulaR1C1 = "FULL"
    Columns("C:J").EntireColumn.AutoFit
    Columns("C:C").Delete Shift:=xlToLeft
    ' DVD LIST
    ' Clear Formatting & clear empty cells
    Sheets("DVD").Select
    ActiveWindow.Zoom = 90
    Range("D:D,J:L,S:S").ClearFormats
    Range("A1").End(xlDown).Offset(1, 0).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ' EXCEPTIONS & CARD COLUMNS
    Columns("A:A").EntireColumn.AutoFit
    Range("T1").FormulaR1C1 = "EXC"
    Range("U1").FormulaR1C1 = "ISCARD"
    'check for filter, turn on if none exists
    If Not ActiveSheet.AutoFilterMode Then
    ActiveSheet.Range("A1").AutoFilter
    End If
    ' Best Sellers
    ActiveWorkbook.Worksheets("DVD").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DVD").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "S:S"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DVD").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A:$U").AutoFilter Field:=19, Criteria1:="<5", _
        Operator:=xlAnd
    Range("S2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    ActiveSheet.Range("$A:$U").AutoFilter Field:=19
    ActiveWorkbook.Worksheets("DVD").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DVD").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "S:S"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DVD").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A:$U").AutoFilter Field:=19, Criteria1:=">=5" _
        , Operator:=xlAnd
    Range("S2").Select
    ActiveCell.FormulaR1C1 = "BEST SELLER"
    'Range("S3").FillDown
    ActiveCell.autofill Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1))
    ActiveSheet.Range("$A:$U").AutoFilter Field:=19
    Application.CutCopyMode = False
    ' Exceptions
    Range("T2").FormulaR1C1 = "=VLOOKUP(RC1,'Exceptions'!C1:C6,6,0)"
    Range("T2").autofill Destination:=Range("T2:T" & Range("A" & Rows.Count).End(xlUp).Row)
    'Selection.autofill Destination:=Range("T2:T158193")
    'ActiveCell.autofill Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1))
    Range("T2").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("DVD").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DVD").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "T:T"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DVD").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A:$U").AutoFilter Field:=20, Criteria1:="=Y", _
        Operator:=xlAnd
    Range("$A2:$U2").Select
    Range(Selection, Selection.End(xlDown)).Delete
    ActiveSheet.Range("$A:$U").AutoFilter Field:=20
    Columns("G:I").Select
    Selection.Delete Shift:=xlToLeft
    Columns("J:O").Select
    Selection.Delete Shift:=xlToLeft
    ' Is Card
    Range("L2").FormulaR1C1 = "=VLOOKUP(RC1,'DVD Card & BS'!C1:C6,6,0)"
    Range("L2").autofill Destination:=Range("L2:L" & Range("A" & Rows.Count).End(xlUp).Row)
    'Selection.autofill Destination:=Range("L2:L148446")
    Range("L2").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("DVD").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DVD").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "L:L"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DVD").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A:$L").AutoFilter Field:=12, Criteria1:="=Y", _
        Operator:=xlAnd
    Range("$A1:$L1").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("A1").Select
    ActiveWindow.Zoom = 90
    ActiveSheet.Name = "DVD_CARD"
    Columns("K:L").Delete Shift:=xlToLeft
    Range("A1").Select
    If Not ActiveSheet.AutoFilterMode Then
    ActiveSheet.Range("A1").AutoFilter
    End If
    Range("G1").FormulaR1C1 = "ASIS"
    Range("H1").FormulaR1C1 = "PARTIAL"
    Range("I1").FormulaR1C1 = "FULL"
    Range("C2").FormulaR1C1 = "=VLOOKUP(RC1,'DVD Card & BS'!C1:C6,4,0)"
    Range("C2").autofill Destination:=Range("C2:C" & Range("A" & Rows.Count).End(xlUp).Row)
    Range("C2").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("L2").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("C:J").EntireColumn.AutoFit
    Range("A1").Select
    ' Delete Card from DVD
    Sheets("DVD").Select
    Application.CutCopyMode = False
    Range("A2:L2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.EntireRow.Delete
    ActiveSheet.Range("$A:$L").AutoFilter Field:=12
    Columns("K:L").Delete Shift:=xlToLeft
    Range("A1").Select
    Range("G1").FormulaR1C1 = "ASIS"
    Range("H1").FormulaR1C1 = "PARTIAL"
    Range("I1").FormulaR1C1 = "FULL"
    Columns("C:J").EntireColumn.AutoFit
    ' Is Bluray
    If ActiveSheet.AutoFilterMode Then
    ActiveSheet.AutoFilterMode = False
    End If
    If Not ActiveSheet.AutoFilterMode Then
    ActiveSheet.Range("A1").AutoFilter
    End If
    ActiveSheet.Range("$A:$T").AutoFilter Field:=3, Criteria1:="=BLU", _
        Operator:=xlOr, Criteria2:="=BLU-GERMAN"
    Range("A1:L1").Select
    Range(Selection, Selection.End(xlDown)).Copy
    ' create Blu Ray
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    ActiveWindow.Zoom = 90
    Columns("B:B").ColumnWidth = 51.27
    ActiveSheet.Name = "BLU RAY"
    Application.CutCopyMode = False
    Range("A1").Select
    If Not ActiveSheet.AutoFilterMode Then
    ActiveSheet.Range("A1").AutoFilter
    End If
    Columns("C:C").Delete Shift:=xlToLeft
    ' Delete DVD Format
    Sheets("DVD").Select
    Columns("C:C").Delete Shift:=xlToLeft
    ' GAME LIST
    ' Clear Formatting & clear empty cells
    Sheets("GAME").Select
    ActiveWindow.Zoom = 90
    Range("D:D,J:L,S:S").ClearFormats
    Range("A1").End(xlDown).Offset(1, 0).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ' EXCEPTIONS COLUMN
    Columns("A:A").EntireColumn.AutoFit
    Range("T1").FormulaR1C1 = "EXC"
    'check for filter, turn on if none exists
    If Not ActiveSheet.AutoFilterMode Then
    ActiveSheet.Range("A1").AutoFilter
    End If
    ' Best Sellers
    ActiveWorkbook.Worksheets("GAME").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("GAME").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "S:S"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("GAME").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A:$U").AutoFilter Field:=19, Criteria1:="<5", _
        Operator:=xlAnd
    Range("S2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    ActiveSheet.Range("$A:$U").AutoFilter Field:=19
    ActiveWorkbook.Worksheets("GAME").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("GAME").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "S:S"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("GAME").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A:$U").AutoFilter Field:=19, Criteria1:=">=5" _
        , Operator:=xlAnd
    Range("S2").FormulaR1C1 = "BEST SELLER"
    'Range("S3").FillDown
    ActiveCell.autofill Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1))
    ActiveSheet.Range("$A:$U").AutoFilter Field:=19
    Application.CutCopyMode = False
    ' Exceptions
    Range("T2").FormulaR1C1 = "=VLOOKUP(RC1,'Exceptions'!C1:C6,6,0)"
    Range("T2").autofill Destination:=Range("T2:T" & Range("A" & Rows.Count).End(xlUp).Row)
    'Selection.autofill Destination:=Range("T2:T158193")
    'ActiveCell.autofill Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1))
    Range("T2").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("GAME").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("GAME").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "T:T"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("GAME").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A:$U").AutoFilter Field:=20, Criteria1:="=Y", _
        Operator:=xlAnd
    Range("$A2:$T2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.Range("$A:$U").AutoFilter Field:=20
    Columns("G:I").Delete Shift:=xlToLeft
    Columns("J:O").Delete Shift:=xlToLeft
    Range("A1").Select
    Range("G1").FormulaR1C1 = "ASIS"
    Range("H1").FormulaR1C1 = "PARTIAL"
    Range("I1").FormulaR1C1 = "FULL"
    Columns("C:J").EntireColumn.AutoFit
    Columns("K:K").Delete Shift:=xlToLeft
    ' BOOK List
    ' Clear Formatting & clear empty cells
    Sheets("BOOK").Select
    ActiveWindow.Zoom = 90
    Range("D:D,J:L").ClearFormats
    Range("A1").End(xlDown).Offset(1, 0).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ' EXCEPTION COLUMN
    Columns("A:A").EntireColumn.AutoFit
    Range("S1").FormulaR1C1 = "EXC"
    'check for filter, turn on if none exists
    If Not ActiveSheet.AutoFilterMode Then
    ActiveSheet.Range("A1").AutoFilter
    End If
    ' Exceptions
    Range("S2").FormulaR1C1 = "=VLOOKUP(RC1,'Exceptions'!C1:C6,6,0)"
    Range("S2").autofill Destination:=Range("S2:S" & Range("A" & Rows.Count).End(xlUp).Row)
    'Selection.autofill Destination:=Range("T2:T158193")
    'ActiveCell.autofill Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1))
    Range("S2").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("BOOK").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("BOOK").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "S:S"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("BOOK").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A:$S").AutoFilter Field:=19, Criteria1:="=Y", _
        Operator:=xlAnd
    Range("$A2:$S2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.Range("$A:$U").AutoFilter Field:=19
    Columns("G:I").Delete Shift:=xlToLeft
    Columns("H:P").Delete Shift:=xlToLeft
    Range("A1").Select
    Range("G1").FormulaR1C1 = "ASIS"
    Columns("C:J").EntireColumn.AutoFit
    Columns("C:E").Delete Shift:=xlToLeft
    ' Format all
    ' FormatCD
    Sheets("CD").Select
    Range("A1:I1").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 8210719
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Columns("A:A").EntireColumn.AutoFit
    Columns("C:I").EntireColumn.AutoFit
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders.Weight = xlThin
    Columns("F:H").Select
    Selection.NumberFormat = "$#,##0.00"
    Range("A1").Select
    ActiveWorkbook.Worksheets("CD").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("CD").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "C:C"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("CD").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1
    ' FormatCD_Card
    Sheets("CD_CARD").Select
    Range("A1:J1").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 8210719
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Columns("A:A").EntireColumn.AutoFit
    Columns("C:J").EntireColumn.AutoFit
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders.Weight = xlThin
    Columns("G:I").Select
    Selection.NumberFormat = "$#,##0.00"
    Range("A1").Select
    ActiveWorkbook.Worksheets("CD_CARD").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("CD_CARD").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "D:D"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("CD_CARD").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1
    ' FormatDVD
    Sheets("DVD").Select
    Range("A1:I1").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 8210719
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Columns("A:A").EntireColumn.AutoFit
    Columns("C:I").EntireColumn.AutoFit
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders.Weight = xlThin
    Columns("F:H").Select
    Selection.NumberFormat = "$#,##0.00"
    Range("A1").Select
    ActiveWorkbook.Worksheets("DVD").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DVD").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "C:C"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DVD").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1
    
    ' FormatBLU
    Sheets("BLU RAY").Select
    Range("A1:I1").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 8210719
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Columns("A:A").EntireColumn.AutoFit
    Columns("C:I").EntireColumn.AutoFit
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders.Weight = xlThin
    Columns("F:H").Select
    Selection.NumberFormat = "$#,##0.00"
    Range("A1").Select
    ActiveWorkbook.Worksheets("BLU RAY").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("BLU RAY").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "C:C"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("BLU RAY").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1
    ' FormatDVD_CARD
    Sheets("DVD_CARD").Select
    Range("A1:J1").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 8210719
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Columns("A:A").EntireColumn.AutoFit
    Columns("C:J").EntireColumn.AutoFit
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders.Weight = xlThin
    Columns("G:I").Select
    Selection.NumberFormat = "$#,##0.00"
    Range("A1").Select
    ActiveWorkbook.Worksheets("DVD_CARD").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DVD_CARD").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "D:D"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DVD_CARD").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1
        ' FormatGAME
    Sheets("GAME").Select
    Range("A1:J1").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 8210719
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Columns("A:A").EntireColumn.AutoFit
    Columns("C:J").EntireColumn.AutoFit
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders.Weight = xlThin
    Columns("G:I").Select
    Selection.NumberFormat = "$#,##0.00"
    Range("A1").Select
    ActiveWorkbook.Worksheets("GAME").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("GAME").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "D:D"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("GAME").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1
    ' FormatBOOK
    Sheets("BOOK").Select
    Range("A1:D1").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 8210719
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Columns("A:A").EntireColumn.AutoFit
    Columns("C:E").EntireColumn.AutoFit
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders.Weight = xlThin
    Columns("D:D").Select
    Selection.NumberFormat = "$#,##0.00"
    Range("A1").Select
    ActiveWorkbook.Worksheets("BOOK").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("BOOK").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "C:C"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("BOOK").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1
    Sheets("Main").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Change .Add2 to .Add everywhere it occurs.

Worked like a charm! cant believe it was something so easy.
thanks for the rescue again Fluff!

now, im also getting the error 1004 copy method of worksheet class failed, again on office 2010

VBA Code:
Sub SaveMasterList()

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
    Sheets(Array("CD", "DVD", "BLU RAY", "GAME", "BOOK", "CD_CARD", "DVD_CARD")).Copy
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True

    Dim file_name As Variant
    Dim FName As String
    FName = "Stocklist - "
    ' Get the file name.
    file_name = Application.GetSaveAsFilename(FName, _
    FileFilter:="Excel Files,*.xlsb,All Files,*.*", _
    Title:="Save As File Name")
    ' See if the user canceled.
    If file_name = False Then Exit Sub
    ' Save the file with the new name.
    If LCase$(Right$(file_name, 4)) <> ".xlsb" Then
    file_name = file_name
    End If
    ActiveWorkbook.SaveAs FileName:=file_name, FileFormat:=xlExcel12

End Sub
 
Upvote 0
Assuming that's on this line Sheets(Array("CD", "DVD", "BLU RAY", "GAME", "BOOK", "CD_CARD", "DVD_CARD")).Copy then I see no reason to get that error.

I could understand a "Subscript out of range" if one of those sheets didn't exist, but not the error you're getting
 
Upvote 0
Assuming that's on this line Sheets(Array("CD", "DVD", "BLU RAY", "GAME", "BOOK", "CD_CARD", "DVD_CARD")).Copy then I see no reason to get that error.

I could understand a "Subscript out of range" if one of those sheets didn't exist, but not the error you're getting

yep on that line. hmm odd. but thats the error it throws up.

i'm off for a week now so ill take another look when im back.
Cheers mate :)
 
Upvote 0

Forum statistics

Threads
1,215,054
Messages
6,122,897
Members
449,097
Latest member
dbomb1414

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