LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
roy roy is offline
external usenet poster
 
Posts: 6
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Shortening a list expect_ed Excel Discussion (Misc queries) 6 April 7th 09 10:31 PM
Shortening a vlookup T De Villiers Excel Worksheet Functions 9 January 27th 06 05:47 PM
shortening a forumula Mike_sharp Excel Discussion (Misc queries) 4 May 4th 05 04:54 PM
Cleaning Product Code list mike meyer Excel Worksheet Functions 6 April 11th 05 08:15 PM
VBA Code -- Cleaning Data Craig[_8_] Excel Programming 2 December 12th 03 12:21 AM


All times are GMT +1. The time now is 01:15 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"