PDA

View Full Version : Excel 2003 speed up code???



csmith
10-01-2008, 10:53 AM
I am having trouble trying to get this to move faster. Any ideas are appreciated!


Sub FORMATPAR()
'
' FORMATPAR Macro
' Macro recorded 9/11/2008 by #lfb104
'
'

Columns("C:F").Select
Selection.Insert Shift:=xlToRight
Range("C5").Select
ActiveCell.FormulaR1C1 = "Division"
Range("D5").Select
ActiveCell.FormulaR1C1 = "Billed"
Range("E5").Select
ActiveCell.FormulaR1C1 = "Received"
Range("F5").Select
ActiveCell.FormulaR1C1 = "Difference"
Range("C6").Select
Do
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Discrepancies!C[-1]:C[1],3,FALSE)"
ActiveCell.Offset(1, 0).Activate

Loop Until ActiveCell.Offset(0, -1) = ""
Range("D6").Select
Do
ActiveCell.FormulaR1C1 = _
"=SUMIF(Discrepancies!C[-2]:C[4],Totals!RC[-2],Discrepancies!C[4])"
ActiveCell.Offset(1, 0).Activate
Loop Until ActiveCell.Offset(0, -1) = ""
Range("E6").Select
Do
ActiveCell.FormulaR1C1 = "=SUMIF(Discrepancies!C[-3]:C[4],Totals!RC[-3],Discrepancies!C[4])"
ActiveCell.Offset(1, 0).Activate
Loop Until ActiveCell.Offset(0, -1) = ""
Range("F6").Select
Do
ActiveCell.FormulaR1C1 = "=SUMIF(Discrepancies!C[-4]:C[4],Totals!RC[-4],Discrepancies!C[4])"
ActiveCell.Offset(1, 0).Activate
Loop Until ActiveCell.Offset(0, -1) = ""
Range("Q6").Select

Range("Q5").Select
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.NumberFormat = "General"
ActiveCell.FormulaR1C1 = "Comments"
With ActiveCell.Characters(Start:=1, Length:=8).Font
.Name = "verdana"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("R5").Select
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.NumberFormat = "General"
ActiveCell.FormulaR1C1 = "Additional Comments"
With ActiveCell.Characters(Start:=1, Length:=19).Font
.Name = "verdana"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("Q6").Select
Do
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-15],Discrepancies!C[-15]:C[-6],10,FALSE)"
ActiveCell.Offset(1, 0).Activate
Loop Until ActiveCell.Offset(0, -1) = ""
Range("R6").Select
Do
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-16],Discrepancies!C[-16]:C[-6],11,FALSE)"
ActiveCell.Offset(1, 0).Activate
Loop Until ActiveCell.Offset(0, -1) = ""

Cells.Select
Range("N25").Activate
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("R:R").Select
Range("R25").Activate
Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False


End Sub

fb7894
10-01-2008, 12:52 PM
Rule #1. It is extremely rare where you have to select an object in order to manipulate it. So you can delete all code that has uses the .select function.

Rule #2. You can turn off the screen updating. Your first line of code will be
Application.ScreenUpdating = False
your last line of code will be.
Application.ScreenUpdating = True

csmith
10-01-2008, 01:15 PM
Thanks for the quick reply!

When I insert this code:




VBA:


Application.ScreenUpdating = False



VBA tags courtesy of



your last line of code will be.




VBA:


Application.ScreenUpdating = True



VBA tags courtesy of



I get an error message that says Compile Error Invalid use of property. Any ideas??

Bob Phillips
10-01-2008, 03:15 PM
You can set the formulae quicker as well



LastRow = Range("B6").End(xlDown).Row
Range("C6").Resize(LastRow - 5).FormulaR1C1 = "=VLOOKUP(RC[-1],Discrepancies!C[-1]:C[1],3,FALSE)"
Range("D6").Resize(LastRow - 5).FormulaR1C1 = _
"=SUMIF(Discrepancies!C[-2]:C[4],Totals!RC[-2],Discrepancies!C[4])"
Range("E6").Resize(LastRow - 5).FormulaR1C1 = "=SUMIF(Discrepancies!C[-3]:C[4],Totals!RC[-3],Discrepancies!C[4])"
Range("F6").Resize(LastRow - 5).FormulaR1C1 = "=SUMIF(Discrepancies!C[-4]:C[4],Totals!RC[-4],Discrepancies!C[4])"