Djblois
06-30-2006, 07:43 AM
Thank you everyone for your help. This is what I got from everyone's help, it is smaller and faster. However, I was wondering if you can help me get it even smaller and faster. It is about half the size of what it was.
Sub Blinco()
'Set Variables
Dim wb As Workbook, Detail As Worksheet, Cust As Worksheet, Prod As Worksheet
Dim rngFind As Range, MyInput As String
Set wb = ActiveWorkbook
Set Detail = wb.ActiveSheet
Detail.Name = "Detail"
MyInput = InputBox("Version 1.2:What do you want to name the File?")
ActiveWorkbook.SaveAs "H:\@temp\Daniel B\Current Projects\" & MyInput
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Sort
Detail.Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort _
Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo
'Delete extra
Detail.Columns("A:A").Find(What:="AT", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Offset(-1, 0).Range("A1").Select
Detail.Range(Selection, Selection.End(xlToRight)).Select
Detail.Range(Selection, Selection.End(xlUp)).EntireRow.Delete
'Create Customer tab
Detail.Columns("A:A").Find(What:="Customer:", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
Detail.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Cut
If wb.Sheets.Count = 1 Then
Set Cust = wb.Worksheets.Add
Else: Set Cust = wb.Sheets(2)
End If
ActiveSheet.Name = "Cust"
ActiveSheet.Paste
'Remove ) from Data
Cust.Columns("A:B").Replace What:=")", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Create Product tab
Set rngFind = Cust.Range("A:A").Find(What:="Product:", After:=Cust.Range("A1"), LookIn:=xlValues, LookAt:=xlPart)
Cust.Range(rngFind, Cust.Cells(Cust.Rows.Count, rngFind.Column)).Cut
If wb.Sheets.Count = 2 Then
Set Prod = wb.Worksheets.Add
Else: Set Prod = wb.Sheets(3)
End If
ActiveSheet.Name = "Prod"
ActiveSheet.Paste
'Create Item# Column in product tab
Prod.Range("B1:B" & Prod.Cells(Prod.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = "=Mid(RC[-1],10,6)"
Prod.Range("B1:B" & Prod.Cells(Prod.Rows.Count, 1).End(xlUp).Row).Value = _
Prod.Range("B1:B" & Prod.Cells(Prod.Rows.Count, 1).End(xlUp).Row).Value
'Create Products Column in product tab
Prod.Range("C1:C" & Prod.Cells(Prod.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = "=PROPER(Trim(MID(RC[-2],18,80)))"
Prod.Range("C1:C" & Prod.Cells(Prod.Rows.Count, 1).End(xlUp).Row).Value = _
Prod.Range("C1:C" & Prod.Cells(Prod.Rows.Count, 1).End(xlUp).Row).Value
'Create Cust# Column in customer tab
Cust.Select
Cust.Range("B1:B" & Cust.Cells(Cust.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = "=Mid(RC[-1],11,4)"
Cust.Range("B1:B" & Cust.Cells(Cust.Rows.Count, 1).End(xlUp).Row).Value = _
Cust.Range("B1:B" & Cust.Cells(Cust.Rows.Count, 1).End(xlUp).Row).Value
Columns("B:B").TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
'Create Customer Column in customer tab
Cust.Range("C1:C" & Cust.Cells(Prod.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = "=PROPER(Trim(MID(RC[-2],17,50)))"
Cust.Range("C1:C" & Cust.Cells(Cust.Rows.Count, 1).End(xlUp).Row).Value = _
Cust.Range("C1:C" & Cust.Cells(Cust.Rows.Count, 1).End(xlUp).Row).Value
Columns("C:C").TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
'Clean Bottem of Database
Detail.Cells.AutoFilter field:=1, Criteria1:="Atalanta*"
On Error Resume Next
Detail.Range("A2:A" & Detail.Rows.Count).EntireRow.SpecialCells(xlCellTypeVisible).Delete
Detail.AutoFilterMode = False
'Delete Columns
Detail.Columns("C:C").Delete Shift:=xlToLeft
Detail.Columns("F:F").Delete Shift:=xlToLeft
Detail.Columns("P:V").Delete Shift:=xlToLeft
'Open Atalanta Codes workbook
Workbooks.Open Filename:="H:\@temp\Daniel B\Reference\Atalanta Codes.xls"
wb.Activate
'Fix Invoice# (A)
Detail.Rows("1:1").Insert Shift:=xlDown
Detail.Range("A1").FormulaR1C1 = "Invoice#"
'Fix Date (B)
Detail.Range("B1").FormulaR1C1 = "Date"
With Detail.Columns("B:B")
.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 3), TrailingMinusNumbers:=True
.NumberFormat = "mm/dd/yy;@"
End With
'Add Warehouses (C)
Detail.Columns("C:C").TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Detail.Columns("D:D").Insert Shift:=xlToRight
Detail.Range("D1").FormulaR1C1 = "Whse"
Detail.Range("D2:D" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[Atalanta Codes.xls]Whses'!C1:C8,2,FALSE)"
Detail.Range("D1:D" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value = _
Detail.Range("D1:D" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value
Detail.Columns("C:C").Delete
'Fix Cust# (D)
Detail.Range("D1").FormulaR1C1 = "Cust#"
Detail.Columns("D:D").TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
'Add Customers (E)
Detail.Columns("E:E").Insert Shift:=xlToRight
Detail.Range("E1").FormulaR1C1 = "Customer"
Detail.Range("E2:E" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = _
"=VLOOKUP(RC[-1],Cust!C[-3]:C[-2],2,FALSE)"
Detail.Range("E1:E" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value = _
Detail.Range("E1:E" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value
'Fix Sls# (F)
Detail.Range("F1").FormulaR1C1 = "Sls#"
Detail.Columns("F:F").TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Detail.Columns("F:F").EntireColumn.Hidden = True
'Add SlsPrsn (G)
Detail.Columns("G:G").Insert Shift:=xlToRight
Detail.Range("G1").FormulaR1C1 = "SlsPrsn"
Detail.Range("G2:G" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[Atalanta Codes.xls]SlsPrsn'!C1:C8,2,FALSE)"
Detail.Range("G1:G" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value = _
Detail.Range("G1:G" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value
'Fix Item# (H)
Detail.Range("H1").FormulaR1C1 = "Item#"
With Detail.Range("H:H")
.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.NumberFormat = "00-0000"
End With
'Add Product (I)
Detail.Columns("I:I").Insert Shift:=xlToRight
Detail.Range("I1").FormulaR1C1 = "Product"
Detail.Range("I2:I" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = _
"=VLOOKUP(Detail!RC[-1],Prod!C[-7]:C[-6],2,FALSE)"
Detail.Range("I1:I" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value = _
Detail.Range("I1:I" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value
'Add Dept (J)
Detail.Columns("J:J").Insert Shift:=xlToRight
Detail.Range("J1").FormulaR1C1 = "Dept"
Detail.Range("J2:J" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = _
"=VLOOKUP(RC[-2],'[Atalanta Codes.xls]Products'!C1:C12,3,FALSE)"
Detail.Range("J1:J" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value = _
Detail.Range("J1:J" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value
'Fix Qty (K)
Detail.Range("K1").FormulaR1C1 = "Qty"
With Detail.Columns("K:K")
.TextToColumns Destination:=Range("K1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.NumberFormat = "#,##0"
End With
'Fix Units (L)
Detail.Range("L1").FormulaR1C1 = "Units"
With Detail.Columns("L:L")
.TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.Style = "Comma"
End With
'Fix Price (M)
Detail.Range("M1").FormulaR1C1 = "Price"
With Detail.Columns("M:M")
.TextToColumns Destination:=Range("M1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.Style = "Comma"
End With
'Add Delivery (N)
Detail.Range("N1").FormulaR1C1 = "Del"
Detail.Range("N2:N" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Replace _
What:="D", Replacement:="Del", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Fix Amt (O)
Detail.Range("O1").FormulaR1C1 = "Amt"
With Detail.Columns("O:O")
.TextToColumns Destination:=Range("O1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.NumberFormat = "#,##0"
End With
'Fix Equivalant (P)
Detail.Range("P1").FormulaR1C1 = "Equivalant"
With Detail.Columns("P:P")
.TextToColumns Destination:=Range("P1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.NumberFormat = "#,##0"
End With
Detail.Columns("P:P").EntireColumn.Hidden = True
'Fix Ext-Cost (Q)
Detail.Range("Q1").FormulaR1C1 = "Ext-Cost"
With Detail.Columns("Q:Q")
.TextToColumns Destination:=Range("Q1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.NumberFormat = "#,##0"
End With
'Fix Unit-Cost (R)
Range("R1").FormulaR1C1 = "Unit-Cost"
With Detail.Columns("R:R")
.TextToColumns Destination:=Range("R1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.NumberFormat = "#,##0"
End With
'Fix Profit (S)
Detail.Range("S1").FormulaR1C1 = "Profit"
With Detail.Columns("S:S")
.TextToColumns Destination:=Range("S1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.NumberFormat = "#,##0"
End With
'Add Percentage to End (T)
Detail.Range("T1").FormulaR1C1 = "%"
Detail.Range("T2:T" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = _
"=IF(RC[-5]=0,""No Sale"",RC[-1]/RC[-5])"
Detail.Range("T1:T" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value = _
Detail.Range("T1:T" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value
Range("T2").Select
With Selection
.NumberFormat = "0.00%"
.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="0"
End With
With Selection.FormatConditions(1)
.Font.Bold = True
.Interior.ColorIndex = 44
End With
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""No Sale"""
With Selection.FormatConditions(2)
.Font.Bold = True
.Interior.ColorIndex = 6
End With
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteFormats
Detail.Columns("T:T").NumberFormat = "0.00%"
'Close Atlanta Codes workbook and delete product and customer lists
Windows("Atalanta Codes.xls").Close
Cust.Delete
Prod.Delete
'Set Print Heading
With Range("A1:T1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
End With
With ActiveSheet.PageSetup
.LeftHeader = "&""Arial,Bold""&12Atalanta"
.CenterHeader = "&""Arial,Bold""&14&A"
.RightHeader = "&""Arial,Bold""&12Sorted by"
.LeftFooter = "&""Arial,Bold""&D &T Dan Blois"
.CenterFooter = "&""Arial,Bold""&F"
.RightFooter = "&""Arial,Bold""Page &P of &N"
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.9)
.BottomMargin = Application.InchesToPoints(0.6)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintGridlines = True
.CenterHorizontally = True
.FitToPagesWide = 1
.PrintTitleRows = "$1:$1"
End With
'Sort By Customer Then Product Then Date
Detail.Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort Key1:=Range("E2"), Order1:=xlAscending, Key2:= _
Range("I2"), Order2:=xlAscending, Key3:=Range("B2"), Order3:=xlDescending _
, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal
'SummarySheets
'Freeze Row 1
Detail.Range("A2").Select
ActiveWindow.FreezePanes = True
End Sub
Sub SummarySheets()
'Add Invoices Tab
Range("A:S").Select
Selection.Copy
Sheets.Add.Name = "By Invoice"
ActiveSheet.Paste
'Add WareHouse Tab
Sheets.Add.Name = "By Warehouse"
ActiveSheet.Paste
'Add Customer Tab
Sheets.Add.Name = "By Customer"
ActiveSheet.Paste
'Add SalesPerson Tab
Sheets.Add.Name = "By SalesPerson"
ActiveSheet.Paste
'Add Product Tab
Sheets.Add.Name = "By Product"
ActiveSheet.Paste
'Add subtotals to Invoices tab
Sheets("By Invoice").Activate
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(11, 12, 15, 17 _
, 18, 19), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Columns("A:S").EntireColumn.AutoFit
Columns("B:J").EntireColumn.Hidden = True
Columns("M:N").EntireColumn.Hidden = True
Columns("P:P").EntireColumn.Hidden = True
Columns("A:A").Replace What:="Total", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A2").Select
ActiveWindow.FreezePanes = True
'Add subtotals to WareHouse tab
Sheets("By WareHouse").Activate
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(11, 12, 15, 17 _
, 18, 19), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Columns("A:S").EntireColumn.AutoFit
Columns("A:B").EntireColumn.Hidden = True
Columns("D:J").EntireColumn.Hidden = True
Columns("M:N").EntireColumn.Hidden = True
Columns("P:P").EntireColumn.Hidden = True
Columns("C:C").Replace What:="Total", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A2").Select
ActiveWindow.FreezePanes = True
'Add subtotals to Customer tab
Sheets("By Customer").Activate
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort Key1:=Range("E2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Subtotal GroupBy:=5, Function:=xlSum, TotalList:=Array(11, 12, 15, 17 _
, 18, 19), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Columns("A:S").EntireColumn.AutoFit
Columns("A:D").EntireColumn.Hidden = True
Columns("F:J").EntireColumn.Hidden = True
Columns("M:N").EntireColumn.Hidden = True
Columns("P:P").EntireColumn.Hidden = True
Columns("E:E").Replace What:="Total", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A2").Select
ActiveWindow.FreezePanes = True
'Add subtotals to SalesPerson tab
Sheets("By SalesPerson").Activate
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort Key1:=Range("G2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Subtotal GroupBy:=7, Function:=xlSum, TotalList:=Array(11, 12, 15, 17 _
, 18, 19), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Columns("A:S").EntireColumn.AutoFit
Columns("A:F").EntireColumn.Hidden = True
Columns("H:J").EntireColumn.Hidden = True
Columns("M:N").EntireColumn.Hidden = True
Columns("P:P").EntireColumn.Hidden = True
Columns("G:G").Replace What:="Total", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A2").Select
ActiveWindow.FreezePanes = True
'Add subtotals to Product tab
Sheets("By Product").Activate
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort Key1:=Range("I2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Subtotal GroupBy:=9, Function:=xlSum, TotalList:=Array(11, 12, 15, 17 _
, 18, 19), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Columns("A:S").EntireColumn.AutoFit
Columns("A:H").EntireColumn.Hidden = True
Columns("J:J").EntireColumn.Hidden = True
Columns("M:N").EntireColumn.Hidden = True
Columns("P:P").EntireColumn.Hidden = True
Columns("I:I").Replace What:="Total", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A2").Select
ActiveWindow.FreezePanes = True
'End
Sheets("Detail").Activate
ActiveWorkbook.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Range("A2").Select
End Sub
P.S. FireFighter I tried to break up the code into pieces but since I am now using variables it won't work unless I declare variables in each piece (Is this correct).
Daniel
Sub Blinco()
'Set Variables
Dim wb As Workbook, Detail As Worksheet, Cust As Worksheet, Prod As Worksheet
Dim rngFind As Range, MyInput As String
Set wb = ActiveWorkbook
Set Detail = wb.ActiveSheet
Detail.Name = "Detail"
MyInput = InputBox("Version 1.2:What do you want to name the File?")
ActiveWorkbook.SaveAs "H:\@temp\Daniel B\Current Projects\" & MyInput
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Sort
Detail.Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort _
Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo
'Delete extra
Detail.Columns("A:A").Find(What:="AT", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Offset(-1, 0).Range("A1").Select
Detail.Range(Selection, Selection.End(xlToRight)).Select
Detail.Range(Selection, Selection.End(xlUp)).EntireRow.Delete
'Create Customer tab
Detail.Columns("A:A").Find(What:="Customer:", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
Detail.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Cut
If wb.Sheets.Count = 1 Then
Set Cust = wb.Worksheets.Add
Else: Set Cust = wb.Sheets(2)
End If
ActiveSheet.Name = "Cust"
ActiveSheet.Paste
'Remove ) from Data
Cust.Columns("A:B").Replace What:=")", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Create Product tab
Set rngFind = Cust.Range("A:A").Find(What:="Product:", After:=Cust.Range("A1"), LookIn:=xlValues, LookAt:=xlPart)
Cust.Range(rngFind, Cust.Cells(Cust.Rows.Count, rngFind.Column)).Cut
If wb.Sheets.Count = 2 Then
Set Prod = wb.Worksheets.Add
Else: Set Prod = wb.Sheets(3)
End If
ActiveSheet.Name = "Prod"
ActiveSheet.Paste
'Create Item# Column in product tab
Prod.Range("B1:B" & Prod.Cells(Prod.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = "=Mid(RC[-1],10,6)"
Prod.Range("B1:B" & Prod.Cells(Prod.Rows.Count, 1).End(xlUp).Row).Value = _
Prod.Range("B1:B" & Prod.Cells(Prod.Rows.Count, 1).End(xlUp).Row).Value
'Create Products Column in product tab
Prod.Range("C1:C" & Prod.Cells(Prod.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = "=PROPER(Trim(MID(RC[-2],18,80)))"
Prod.Range("C1:C" & Prod.Cells(Prod.Rows.Count, 1).End(xlUp).Row).Value = _
Prod.Range("C1:C" & Prod.Cells(Prod.Rows.Count, 1).End(xlUp).Row).Value
'Create Cust# Column in customer tab
Cust.Select
Cust.Range("B1:B" & Cust.Cells(Cust.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = "=Mid(RC[-1],11,4)"
Cust.Range("B1:B" & Cust.Cells(Cust.Rows.Count, 1).End(xlUp).Row).Value = _
Cust.Range("B1:B" & Cust.Cells(Cust.Rows.Count, 1).End(xlUp).Row).Value
Columns("B:B").TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
'Create Customer Column in customer tab
Cust.Range("C1:C" & Cust.Cells(Prod.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = "=PROPER(Trim(MID(RC[-2],17,50)))"
Cust.Range("C1:C" & Cust.Cells(Cust.Rows.Count, 1).End(xlUp).Row).Value = _
Cust.Range("C1:C" & Cust.Cells(Cust.Rows.Count, 1).End(xlUp).Row).Value
Columns("C:C").TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
'Clean Bottem of Database
Detail.Cells.AutoFilter field:=1, Criteria1:="Atalanta*"
On Error Resume Next
Detail.Range("A2:A" & Detail.Rows.Count).EntireRow.SpecialCells(xlCellTypeVisible).Delete
Detail.AutoFilterMode = False
'Delete Columns
Detail.Columns("C:C").Delete Shift:=xlToLeft
Detail.Columns("F:F").Delete Shift:=xlToLeft
Detail.Columns("P:V").Delete Shift:=xlToLeft
'Open Atalanta Codes workbook
Workbooks.Open Filename:="H:\@temp\Daniel B\Reference\Atalanta Codes.xls"
wb.Activate
'Fix Invoice# (A)
Detail.Rows("1:1").Insert Shift:=xlDown
Detail.Range("A1").FormulaR1C1 = "Invoice#"
'Fix Date (B)
Detail.Range("B1").FormulaR1C1 = "Date"
With Detail.Columns("B:B")
.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 3), TrailingMinusNumbers:=True
.NumberFormat = "mm/dd/yy;@"
End With
'Add Warehouses (C)
Detail.Columns("C:C").TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Detail.Columns("D:D").Insert Shift:=xlToRight
Detail.Range("D1").FormulaR1C1 = "Whse"
Detail.Range("D2:D" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[Atalanta Codes.xls]Whses'!C1:C8,2,FALSE)"
Detail.Range("D1:D" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value = _
Detail.Range("D1:D" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value
Detail.Columns("C:C").Delete
'Fix Cust# (D)
Detail.Range("D1").FormulaR1C1 = "Cust#"
Detail.Columns("D:D").TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
'Add Customers (E)
Detail.Columns("E:E").Insert Shift:=xlToRight
Detail.Range("E1").FormulaR1C1 = "Customer"
Detail.Range("E2:E" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = _
"=VLOOKUP(RC[-1],Cust!C[-3]:C[-2],2,FALSE)"
Detail.Range("E1:E" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value = _
Detail.Range("E1:E" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value
'Fix Sls# (F)
Detail.Range("F1").FormulaR1C1 = "Sls#"
Detail.Columns("F:F").TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Detail.Columns("F:F").EntireColumn.Hidden = True
'Add SlsPrsn (G)
Detail.Columns("G:G").Insert Shift:=xlToRight
Detail.Range("G1").FormulaR1C1 = "SlsPrsn"
Detail.Range("G2:G" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[Atalanta Codes.xls]SlsPrsn'!C1:C8,2,FALSE)"
Detail.Range("G1:G" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value = _
Detail.Range("G1:G" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value
'Fix Item# (H)
Detail.Range("H1").FormulaR1C1 = "Item#"
With Detail.Range("H:H")
.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.NumberFormat = "00-0000"
End With
'Add Product (I)
Detail.Columns("I:I").Insert Shift:=xlToRight
Detail.Range("I1").FormulaR1C1 = "Product"
Detail.Range("I2:I" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = _
"=VLOOKUP(Detail!RC[-1],Prod!C[-7]:C[-6],2,FALSE)"
Detail.Range("I1:I" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value = _
Detail.Range("I1:I" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value
'Add Dept (J)
Detail.Columns("J:J").Insert Shift:=xlToRight
Detail.Range("J1").FormulaR1C1 = "Dept"
Detail.Range("J2:J" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = _
"=VLOOKUP(RC[-2],'[Atalanta Codes.xls]Products'!C1:C12,3,FALSE)"
Detail.Range("J1:J" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value = _
Detail.Range("J1:J" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value
'Fix Qty (K)
Detail.Range("K1").FormulaR1C1 = "Qty"
With Detail.Columns("K:K")
.TextToColumns Destination:=Range("K1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.NumberFormat = "#,##0"
End With
'Fix Units (L)
Detail.Range("L1").FormulaR1C1 = "Units"
With Detail.Columns("L:L")
.TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.Style = "Comma"
End With
'Fix Price (M)
Detail.Range("M1").FormulaR1C1 = "Price"
With Detail.Columns("M:M")
.TextToColumns Destination:=Range("M1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.Style = "Comma"
End With
'Add Delivery (N)
Detail.Range("N1").FormulaR1C1 = "Del"
Detail.Range("N2:N" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Replace _
What:="D", Replacement:="Del", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Fix Amt (O)
Detail.Range("O1").FormulaR1C1 = "Amt"
With Detail.Columns("O:O")
.TextToColumns Destination:=Range("O1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.NumberFormat = "#,##0"
End With
'Fix Equivalant (P)
Detail.Range("P1").FormulaR1C1 = "Equivalant"
With Detail.Columns("P:P")
.TextToColumns Destination:=Range("P1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.NumberFormat = "#,##0"
End With
Detail.Columns("P:P").EntireColumn.Hidden = True
'Fix Ext-Cost (Q)
Detail.Range("Q1").FormulaR1C1 = "Ext-Cost"
With Detail.Columns("Q:Q")
.TextToColumns Destination:=Range("Q1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.NumberFormat = "#,##0"
End With
'Fix Unit-Cost (R)
Range("R1").FormulaR1C1 = "Unit-Cost"
With Detail.Columns("R:R")
.TextToColumns Destination:=Range("R1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.NumberFormat = "#,##0"
End With
'Fix Profit (S)
Detail.Range("S1").FormulaR1C1 = "Profit"
With Detail.Columns("S:S")
.TextToColumns Destination:=Range("S1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.NumberFormat = "#,##0"
End With
'Add Percentage to End (T)
Detail.Range("T1").FormulaR1C1 = "%"
Detail.Range("T2:T" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = _
"=IF(RC[-5]=0,""No Sale"",RC[-1]/RC[-5])"
Detail.Range("T1:T" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value = _
Detail.Range("T1:T" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value
Range("T2").Select
With Selection
.NumberFormat = "0.00%"
.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="0"
End With
With Selection.FormatConditions(1)
.Font.Bold = True
.Interior.ColorIndex = 44
End With
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""No Sale"""
With Selection.FormatConditions(2)
.Font.Bold = True
.Interior.ColorIndex = 6
End With
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteFormats
Detail.Columns("T:T").NumberFormat = "0.00%"
'Close Atlanta Codes workbook and delete product and customer lists
Windows("Atalanta Codes.xls").Close
Cust.Delete
Prod.Delete
'Set Print Heading
With Range("A1:T1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
End With
With ActiveSheet.PageSetup
.LeftHeader = "&""Arial,Bold""&12Atalanta"
.CenterHeader = "&""Arial,Bold""&14&A"
.RightHeader = "&""Arial,Bold""&12Sorted by"
.LeftFooter = "&""Arial,Bold""&D &T Dan Blois"
.CenterFooter = "&""Arial,Bold""&F"
.RightFooter = "&""Arial,Bold""Page &P of &N"
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.9)
.BottomMargin = Application.InchesToPoints(0.6)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintGridlines = True
.CenterHorizontally = True
.FitToPagesWide = 1
.PrintTitleRows = "$1:$1"
End With
'Sort By Customer Then Product Then Date
Detail.Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort Key1:=Range("E2"), Order1:=xlAscending, Key2:= _
Range("I2"), Order2:=xlAscending, Key3:=Range("B2"), Order3:=xlDescending _
, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal
'SummarySheets
'Freeze Row 1
Detail.Range("A2").Select
ActiveWindow.FreezePanes = True
End Sub
Sub SummarySheets()
'Add Invoices Tab
Range("A:S").Select
Selection.Copy
Sheets.Add.Name = "By Invoice"
ActiveSheet.Paste
'Add WareHouse Tab
Sheets.Add.Name = "By Warehouse"
ActiveSheet.Paste
'Add Customer Tab
Sheets.Add.Name = "By Customer"
ActiveSheet.Paste
'Add SalesPerson Tab
Sheets.Add.Name = "By SalesPerson"
ActiveSheet.Paste
'Add Product Tab
Sheets.Add.Name = "By Product"
ActiveSheet.Paste
'Add subtotals to Invoices tab
Sheets("By Invoice").Activate
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(11, 12, 15, 17 _
, 18, 19), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Columns("A:S").EntireColumn.AutoFit
Columns("B:J").EntireColumn.Hidden = True
Columns("M:N").EntireColumn.Hidden = True
Columns("P:P").EntireColumn.Hidden = True
Columns("A:A").Replace What:="Total", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A2").Select
ActiveWindow.FreezePanes = True
'Add subtotals to WareHouse tab
Sheets("By WareHouse").Activate
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(11, 12, 15, 17 _
, 18, 19), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Columns("A:S").EntireColumn.AutoFit
Columns("A:B").EntireColumn.Hidden = True
Columns("D:J").EntireColumn.Hidden = True
Columns("M:N").EntireColumn.Hidden = True
Columns("P:P").EntireColumn.Hidden = True
Columns("C:C").Replace What:="Total", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A2").Select
ActiveWindow.FreezePanes = True
'Add subtotals to Customer tab
Sheets("By Customer").Activate
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort Key1:=Range("E2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Subtotal GroupBy:=5, Function:=xlSum, TotalList:=Array(11, 12, 15, 17 _
, 18, 19), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Columns("A:S").EntireColumn.AutoFit
Columns("A:D").EntireColumn.Hidden = True
Columns("F:J").EntireColumn.Hidden = True
Columns("M:N").EntireColumn.Hidden = True
Columns("P:P").EntireColumn.Hidden = True
Columns("E:E").Replace What:="Total", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A2").Select
ActiveWindow.FreezePanes = True
'Add subtotals to SalesPerson tab
Sheets("By SalesPerson").Activate
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort Key1:=Range("G2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Subtotal GroupBy:=7, Function:=xlSum, TotalList:=Array(11, 12, 15, 17 _
, 18, 19), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Columns("A:S").EntireColumn.AutoFit
Columns("A:F").EntireColumn.Hidden = True
Columns("H:J").EntireColumn.Hidden = True
Columns("M:N").EntireColumn.Hidden = True
Columns("P:P").EntireColumn.Hidden = True
Columns("G:G").Replace What:="Total", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A2").Select
ActiveWindow.FreezePanes = True
'Add subtotals to Product tab
Sheets("By Product").Activate
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort Key1:=Range("I2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Subtotal GroupBy:=9, Function:=xlSum, TotalList:=Array(11, 12, 15, 17 _
, 18, 19), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Columns("A:S").EntireColumn.AutoFit
Columns("A:H").EntireColumn.Hidden = True
Columns("J:J").EntireColumn.Hidden = True
Columns("M:N").EntireColumn.Hidden = True
Columns("P:P").EntireColumn.Hidden = True
Columns("I:I").Replace What:="Total", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A2").Select
ActiveWindow.FreezePanes = True
'End
Sheets("Detail").Activate
ActiveWorkbook.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Range("A2").Select
End Sub
P.S. FireFighter I tried to break up the code into pieces but since I am now using variables it won't work unless I declare variables in each piece (Is this correct).
Daniel