Slow VBA Code

[tudorpe]

Any idea why this code is so slow? It used to run fine it now take
around 20 seconds to complete

any help would be appriciated.

Sub record_new_record()
Dim prev As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Sheets("Records").Unprotect

Sheets("Records").Select
Range("A1").End(xlDown).Offset(1, 0).Select

prev = ActiveCell.Offset(rowoffset:=-1, columnoffset:=0).Value
Selection.Value = prev + 1
ActiveCell.Next.Select
' gives record an individual number automatically

Sheets("OEE").Range("b1").Copy
Sheets("Records").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
' pastes date
ActiveCell.Next.Select

Sheets("OEE").Range("d5").Copy
Sheets("Records").Select
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
'ActiveCell.Next.Select


ActiveCell.FormulaR1C1 = "=SUBTOTAL(3, R[0]C[-59])"
ActiveCell.Next.Select

ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-58], Products, 29, FALSE)"
ActiveCell.Copy
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

ActiveCell.Next.Select

'' LOTS MORE CUT & PASTE BITS HERE

Rows("1:1").Select
Range(Selection, Selection.End(xlDown)).Select ' formats used rows
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = False
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With

Cells.Select
With Selection.Validation ' remove validation from cells
.Delete ' which have been copied
End With ' from Sheet
Selection.Columns.AutoFit

Selection.Font.ColorIndex = 0 ' end of row formatting
Range("a2").Select
Sheets("Records").Protect ' protects sheet


Sheets("OEE").Select
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Dim Msg, Style, Title, Response
Msg = "Do you want to clear the screen?" ' Define message.
Style = vbYesNo + vbQuestion + vbDefaultButton2 ' Define buttons.
Title = "Reset Form" ' Define title.

Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then ' User chose Yes.
Application.Run "'Line 15 OEE.xls'!Module6.clear"
End If

End Su

 

[Andy Wiggins]

Have you changed the code?
If not, what else has changed?
Has the volume of data increased?
Are other applications open that take memory?
Are you using a different PC?
Do you have an addin installed that wasn't there when the code ran faster?

--
Regards
Andy Wiggins
www.BygSoftware.com
Home of "Save and BackUp",
"The Excel Auditor" and "Byg Tools for VBA"

Any idea why this code is so slow? It used to run fine it now takes
around 20 seconds to complete

any help would be appriciated.

Sub record_new_record()
Dim prev As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Sheets("Records").Unprotect

Sheets("Records").Select
Range("A1").End(xlDown).Offset(1, 0).Select

prev = ActiveCell.Offset(rowoffset:=-1, columnoffset:=0).Value
Selection.Value = prev + 1
ActiveCell.Next.Select
' gives record an individual number automatically

Sheets("OEE").Range("b1").Copy
Sheets("Records").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
' pastes date
ActiveCell.Next.Select

Sheets("OEE").Range("d5").Copy
Sheets("Records").Select
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
'ActiveCell.Next.Select


ActiveCell.FormulaR1C1 = "=SUBTOTAL(3, R[0]C[-59])"
ActiveCell.Next.Select

ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-58], Products, 29, FALSE)"
ActiveCell.Copy
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

ActiveCell.Next.Select

'' LOTS MORE CUT & PASTE BITS HERE

Rows("1:1").Select
Range(Selection, Selection.End(xlDown)).Select ' formats used rows
With Selection
HorizontalAlignment = xlCenter
VerticalAlignment = xlBottom
WrapText = False
Orientation = 0
AddIndent = False
IndentLevel = 0
ShrinkToFit = False
ReadingOrder = xlContext
MergeCells = False
End With
Selection.Font.Bold = False
With Selection.Font
Name = "Arial"
Size = 10
Strikethrough = False
Superscript = False
Subscript = False
OutlineFont = False
Shadow = False
Underline = xlUnderlineStyleNone
End With

Cells.Select
With Selection.Validation ' remove validation from cells
Delete ' which have been copied
End With ' from Sheet
Selection.Columns.AutoFit

Selection.Font.ColorIndex = 0 ' end of row formatting
Range("a2").Select
Sheets("Records").Protect ' protects sheet


Sheets("OEE").Select
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Dim Msg, Style, Title, Response
Msg = "Do you want to clear the screen?" ' Define message.
Style = vbYesNo + vbQuestion + vbDefaultButton2 ' Define buttons.
Title = "Reset Form" ' Define title.

Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then ' User chose Yes.
Application.Run "'Line 15 OEE.xls'!Module6.clear"
End If

End Sub

 

[tudorpe]

The only piece that has been added is the message box that says "Do yo
want to clear the screen?" and then if you reply "Yes" it run anothe
procedure, but it was running slow before i added this (i've trie
taking this out (deleting it) and it still runs slow.)

No other applications are open
No addins have been added
and the PC is the same

Could it be the cell formatting piece of the procedure where i remov
any colouration, boldness ect.... that makes it run slow.

There are only 10 or so records (rows) that are formatted at th
minute, though they do strech from column A to column BL.

Sorry for the slow responc

 

[Andy Wiggins]

If your code is running slowly then you will have to investigate why.

Put a timer into parts of your code so you can identify where the
bottlenecks are occurring - Debug.Print is good for this.

Please don't use forums - use the newsgroup directly, that way parts of
threads don't go missing.

--
Regards
Andy Wiggins
www.BygSoftware.com
Home of "Save and BackUp",
"The Excel Auditor" and "Byg Tools for VBA"