Help with shortening/cleaning some code please

[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:::::::::::::::::::::::

 

[Martin]

Roy,

I am no expert. I have been playing with Excel/VBA for some years now and my
limited knowledge has come from searching the newsgroups for similar
scenarios.

If YOU simplify your code, you stand a better chance of understanding it
should you need to amend it in the future.

Three points:

1. Read http://www.cpearson.com/excel/newposte.htm

2. Look at the code yourself...when recording this procedure, you have made
some errors and then rectified them, e.g.,

Selection.NumberFormat = "0.0"
Selection.NumberFormat = "0.00"
and
Selection.Font.Bold = True
Selection.Font.Bold = False

It's unlikely that both lines are required. Start with those.
Look for others.

3. "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...."

Where you have

"Range("C2:L340").Select"

assuming you have no blank cells in Column L,

Range([C2], [L2].End(xlDown)).Select

will work for the last cell down from L2, but
if cells may be blank then you would probably be better
using

Range([C2], [L65536].End(xlUp)).Select

because this goes from L65536 upwards.

Try it. Post back with specific problems and these can be
answered by someone significantly better than me
(and there are lots of those!).

Martin

 

[Tom Ogilvy]

Range([C2], [L65536].End(xlUp)).Select

Don't use notation like the above. It incurs tremendous overhead.

Range(Range("C2"),Range("L65536").End(xlup)).Select

would be much faster although you also need to learn how to program without
using select except where it is absolutely required.

--
Regards,
Tom Ogilvy

Roy,

I am no expert. I have been playing with Excel/VBA for some years now and my
limited knowledge has come from searching the newsgroups for similar
scenarios.

If YOU simplify your code, you stand a better chance of understanding it
should you need to amend it in the future.

Three points:

1. Read http://www.cpearson.com/excel/newposte.htm

2. Look at the code yourself...when recording this procedure, you have made
some errors and then rectified them, e.g.,

Selection.NumberFormat = "0.0"
Selection.NumberFormat = "0.00"
and
Selection.Font.Bold = True
Selection.Font.Bold = False

It's unlikely that both lines are required. Start with those.
Look for others.

3. "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...."

Where you have

"Range("C2:L340").Select"

assuming you have no blank cells in Column L,

Range([C2], [L2].End(xlDown)).Select

will work for the last cell down from L2, but
if cells may be blank then you would probably be better
using

Range([C2], [L65536].End(xlUp)).Select

because this goes from L65536 upwards.

Try it. Post back with specific problems and these can be
answered by someone significantly better than me
(and there are lots of those!).

Martin

Hi

CODE ENDS HERE:::::::::::::::::::::::

 

[Martin]

Tom,

Thanks for the comment,

I have now found, read and inwardly digested
http://support.microsoft.com/default.aspx?scid=KB;en-us;104502
XL: Square Bracket Notation Is Less Efficient Than Tunneling.

I'll try not to make the same mistake twice.

Martin

Range([C2], [L65536].End(xlUp)).Select

Don't use notation like the above. It incurs tremendous overhead.

Range(Range("C2"),Range("L65536").End(xlup)).Select

would be much faster although you also need to learn how to program without
using select except where it is absolutely required.

--
Regards,
Tom Ogilvy

Roy,

I am no expert.

answered by someone significantly better than me
(and there are lots of those!).

Martin