Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with shortening/cleaning some code please
Hi all you wonderfull programmers out there, if someone has a little
spare time in their busy schedule I would like some assistance in cleaning up some code if at all possible. Have built a macro via the "recorder" which does what it is meant to within a reasonable time frame for the data tested, the only snag I am going to come across is that the row quantities in the "real" file that this macro has been created for are going to be varying onevery new incstance of the file. Sometimes it will be 500-600 rows but on other occasions it will be more like 29,000-30,000 rows, am concerned about the time to run the macro when it encounters a huge quantity of data will. Would love to have the codeing (below) simplified in a manner that I may be able to understand should I need to amend it in the future, as I gather that the more "streamlined" a piece of code is the more smoother and faster it will work. Many thanks in advance to anybody who is able to help with this one, your assistance will be very much appreciated. Regards, Roy. CODE STARTS HE:::::::::::::::::::: Sub CRSA_Coding() Columns("A:AE").Select Selection.Copy Sheets("Sheet2").Select ActiveSheet.Paste Range( _ "A:A,E:E,G:G,I:I,K:K,M:M,O:O,Q:Q,S:S,U:U,W:W,X:X,Y :Y,Z:Z,AA:AA,AB:AB,AC:AC,AD:AD,AE:AE" _ ).Select Selection.Delete Shift:=xlToLeft Range("C2:L340").Select Selection.Replace What:="Mostly", Replacement:="100", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False Selection.Replace What:="Always", Replacement:="75", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False Selection.Replace What:="Sometimes", Replacement:="50", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False Selection.Replace What:="Never", Replacement:="25", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False Range("C1").Select Selection.EntireColumn.Insert Selection.EntireColumn.Insert Range("C1").Select ActiveCell.FormulaR1C1 = "Region" Range("D1").Select ActiveCell.FormulaR1C1 = "Cluster" Range("C2").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],personal.xls!No,3,FALSE)" Range("D2").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],personal.xls!No,4,FALSE)" Range("C2").Select Selection.AutoFill Destination:=Range("C2:C339") Range("C2:C339").Select Range("D2").Select Selection.AutoFill Destination:=Range("D2:D339") Range("D2:D339").Select Columns("A:N").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .ShrinkToFit = False .MergeCells = False End With Columns("C:D").Select Selection.Copy Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("A1").Select Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("D2") _ , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _ False, Orientation:=xlTopToBottom Range("O1").Select ActiveCell.FormulaR1C1 = "Count" Range("P1").Select ActiveCell.FormulaR1C1 = "Score" Range("O2").Select ActiveCell.FormulaR1C1 = "=COUNT(RC[-10]:RC[-1]=1,1)" Range("O2").Select Selection.AutoFill Destination:=Range("O2:O339") Range("P2").Select ActiveCell.FormulaR1C1 = "=AVERAGE(RC[-11]:RC[-2])" Selection.AutoFill Destination:=Range("P2:P339") Columns("P:P").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .ShrinkToFit = False .MergeCells = False End With Range("O:O").Select Selection.Delete Shift:=xlToLeft Range("A1").Select Columns("A:O").Select Selection.Copy Sheets("Sheet3").Select ActiveSheet.Paste Columns("A:O").Select Selection.Font.Bold = False Sheets("Sheet3").Select Range("A1").Select Selection.subtotal GroupBy:=4, Function:=xlAverage, TotalList:=Array(5, 6, _ 7, 8, 9, 10, 11, 12, 13, 14, 15), Replace:=True, PageBreaks:=False, _ SummaryBelowData:=True ActiveSheet.Outline.ShowLevels RowLevels:=2 Range("A1:O421").Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy Sheets.Add ActiveSheet.Paste Application.CutCopyMode = False Range("A1").Select Sheets("Sheet3").Select Range("A1").Select Sheets("Sheet3").Select Sheets("Sheet3").Move Befo=Sheets(3) Sheets("Sheet4").Select Columns("A:C").Select Selection.Delete Shift:=xlToLeft Range("B2:O83").Select Selection.NumberFormat = "0.0" Selection.NumberFormat = "0.00" Cells.Select With Selection.Font .Size = 8 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("A1").Select Sheets("Sheet2").Select Range("A1").Select Selection.subtotal GroupBy:=3, Function:=xlAverage, TotalList:=Array(5, 6, _ 7, 8, 9, 10, 11, 12, 13, 14, 15), Replace:=True, PageBreaks:=False, _ SummaryBelowData:=True ActiveSheet.Outline.ShowLevels RowLevels:=2 Range("A1:AG550").Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy Sheets.Add ActiveSheet.Paste Range("A:B,D:D").Select Range("D1").Activate Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft Cells.Select Selection.Font.Bold = True Selection.Font.Bold = False With Selection.Font .Size = 8 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("B2:AG14").Select Selection.NumberFormat = "0.00" Range("A1").Select Sheets("Sheet5").Move After:=Sheets(5) Range("A1").Select Sheets("Sheet1").Select Range("A1").Select Sheets("Sheet2").Select ActiveSheet.Outline.ShowLevels RowLevels:=3 Range("E2:AG352").Select Selection.NumberFormat = "0.0" Selection.NumberFormat = "0.00" Cells.Select Selection.Font.Bold = True Selection.Font.Bold = False Range("A1").Select ActiveSheet.Outline.ShowLevels RowLevels:=2 Rows("1:1").RowHeight = 39 Columns("C:C").EntireColumn.AutoFit Columns("C:C").ColumnWidth = 11 Rows("1:1").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .ShrinkToFit = False .MergeCells = False End With Columns("E:O").Select Selection.ColumnWidth = 11 Range("O1").Select ActiveWindow.LargeScroll ToRight:=-1 Sheets("Sheet3").Select Cells.Select Selection.Font.Bold = True Selection.Font.Bold = False Columns("E:O").Select Selection.ColumnWidth = 11 Rows("1:1").Select Selection.RowHeight = 36 With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .ShrinkToFit = False .MergeCells = False End With ActiveWindow.LargeScroll ToRight:=0 Range("E4:O421").Select Selection.NumberFormat = "0.0" Selection.NumberFormat = "0.00" Range("A1").Select Sheets("Sheet4").Select Cells.Select Selection.Font.Bold = True Selection.Font.Bold = False Columns("A:L").Select Selection.ColumnWidth = 11 Range("A1").Select Rows("1:1").RowHeight = 36 Rows("1:1").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .ShrinkToFit = False .MergeCells = False End With Range("A1").Select Sheets("Sheet5").Select Columns("A:L").Select Selection.ColumnWidth = 11 Rows("1:1").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .ShrinkToFit = False .MergeCells = False End With Range("A1").Select Rows("1:1").RowHeight = 36 Sheets("Sheet1").Select Range("A1").Select Sheets("Sheet2").Select Range("A1").Select Sheets("Sheet3").Select Range("A1").Select Sheets("Sheet4").Select Range("A1").Select Sheets("Sheet5").Select Range("A1").Select End Sub CODE ENDS HE:::::::::::::::::::::: |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Shortening a list | Excel Discussion (Misc queries) | |||
Shortening a vlookup | Excel Worksheet Functions | |||
shortening a forumula | Excel Discussion (Misc queries) | |||
Cleaning Product Code list | Excel Worksheet Functions | |||
VBA Code -- Cleaning Data | Excel Programming |