R
roy
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 HERE:::::::::::::::::::::
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("D2339")
Range("D2339").Select
Columns("A:N").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Columns("C").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("P2339")
Columns("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 Before:=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").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 HERE:::::::::::::::::::::::
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 HERE:::::::::::::::::::::
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("D2339")
Range("D2339").Select
Columns("A:N").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Columns("C").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("P2339")
Columns("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 Before:=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").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 HERE:::::::::::::::::::::::