Best Sellers Template Constant Number of Columns varies levels of rows

cgreene87

New Member
Joined
Oct 25, 2014
Messages
16
Hi All,

Was hoping someone could help me out with a best seller's template I am devising. I used a marco to record the steps (involving creating a pivot table and vlookups). My issue is I have to do this for multiple brands, hence the data is derived from multiple reports of which have a various number of rows (one report may have 100,000 lines and another 200,000 and yet another 50,000) . The columns however remain constant. This may be a novice question but how do I have the below macro select all the rows and columns of data (I tried to do a named range but this did not work) and then create the pivot tables from there? Please see below. (I have put in the bold lines that need amending. Furthermore, I need the file to save with the name "Best Seller and then the value in cell B4 on sheet 4.

Any assistance whatsoever is greatly apperciated.

Sub BESTELLERS()'
' BESTELLERS Macro
'
' Keyboard Shortcut: Ctrl+Shift+B
'
Range("A1:L17").Select
Range("L17").Activate
Selection.EntireRow.Delete
Rows("2:2").Select
Selection.Delete Shift:=xlUp
Range("A1:BT9124").Select
Range("F9").Activate
ActiveWorkbook.Names.Add Name:="alldata", RefersToR1C1:= _
"=Sheet1!R1C1:R9124C72"
Columns("E:R").Select
ActiveWorkbook.Names.Add Name:="hierarchy", RefersToR1C1:="=Sheet1!C5:C18"
Range("C2").Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
Columns("A:A").EntireColumn.AutoFit
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
TrailingMinusNumbers:=True
Columns("B:E").Select
Selection.ClearContents
Range("A1").Select
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "Brand Name"
Range("B6").Select
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Raw Data"
Range("A1:BT9124").Select
Range("E12").Activate
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"alldata", Version:=xlPivotTableVersion15).CreatePivotTable TableDestination _
:="Sheet1!R3C1", TableName:="PivotTable1", DefaultVersion:= _
xlPivotTableVersion15
Sheets("Sheet1").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("ITEM_DESC")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("WK_SOLD_QTY")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("WK_SOLD_QTY"), "Count of WK_SOLD_QTY", xlCount
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Count of WK_SOLD_QTY")
.Caption = "Sum of WK_SOLD_QTY"
.Function = xlSum
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("WK_SOLD_VALUE"), "Count of WK_SOLD_VALUE", xlCount
With ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Count of WK_SOLD_VALUE")
.Caption = "Sum of WK_SOLD_VALUE"
.Function = xlSum
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("MONTH_SOLD_QTY"), "Sum of MONTH_SOLD_QTY", xlSum
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("MONTH_SOLD_VALUE"), "Sum of MONTH_SOLD_VALUE", _
xlSum
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("CLOSING_QTY"), "Sum of CLOSING_QTY", xlSum
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("PERIODRETAIL"), "Sum of PERIODRETAIL", xlSum
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of PERIODRETAIL")
.Caption = "Average of PERIODRETAIL"
.Function = xlAverage
End With
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A3:G1272").Select
Range("C11").Activate
Selection.Copy
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Sheets("Sheet3").Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Columns("G:G").EntireColumn.AutoFit
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").Select
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "VPN"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Week Sold Qty"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Week Sold Value"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Month Sold Qty"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Month Sold Value"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Closing Qty"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Period Retail"
Range("A1:G1270").Select
Range("E2").Activate
ActiveWindow.ScrollColumn = 1
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B1").Select
ActiveCell.FormulaR1C1 = "Subclass"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Class"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Department"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Season"
Range("F1").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("B2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],hierarchy,11,FALSE)"
Range("G2").Select
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B1270")
Range("B2:B1270").Select
Range("C2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],hierarchy,9,FALSE)"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C1270")
Range("C2:C1270").Select
Range("D2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],hierarchy,7,FALSE)"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D1270")
Range("D2:D1270").Select
Range("E2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-1]C[-4],hierarchy,15,FALSE)"
Range("E2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-1]C[-4],hierarchy,14,FALSE)"
Range("E2").Select
Sheets("Raw Data").Select
Application.Goto Reference:="hierarchy"
Sheets("Sheet3").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],hierarchy,14,FALSE)"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E1270")
Range("E2:E1270").Select
Range("A1:K1270").Select
Range("C6").Activate
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("F2:F1270" _
), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("G2:G1270" _
), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A1:K1270")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Rows("2:2").Select
Range("C2").Activate
Selection.Delete Shift:=xlUp
Range("C1:G16").Select
Selection.Copy
Sheets("Sheet1").Select
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet2").Select
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.Delete
Sheets("Sheet3").Select
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
Range("A1:K16").Select
Range("K16").Activate
Selection.Copy
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").Select
Columns("B:B").EntireColumn.AutoFit
Columns("D:D").Select
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("I:I").EntireColumn.AutoFit
ActiveWindow.ScrollColumn = 2
Columns("J:J").EntireColumn.AutoFit
Columns("K:K").EntireColumn.AutoFit
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Best Sellers"
Range("B1").Select
ActiveCell.FormulaR1C1 = "='Brand Name'!RC[-1]"
Range("A1:B1").Select
Range("B1").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
With Selection.Font
.Name = "Calibri"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Selection.Font.Bold = True
Range("A1").Select
Sheets("Sheet3").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Brand Name").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Raw Data").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
ChDir "C:\Users\Craig\Desktop"
Range("A1:B1").Select
Range("B1").Activate
Selection.Copy
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\Craig\Desktop\Best Sellers Cortefiel .xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False



End Sub
 

Some videos you may like

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

Watch MrExcel Video

Forum statistics

Threads
1,118,656
Messages
5,573,431
Members
412,529
Latest member
cTatch
Top