You should try to do withOUT selections as they are rarely necessary and
slow down code. You probably won't need the application off/on.
Use the with statement as you did with those. Don't forget to put the .
s in the right places.

SelectItem Macro
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

with Sheets("Orders")
.range("A31").value=.Range("ID")
.Range("A31")=NOW()
.Range("C1").value=.Range("OF_SETS")
'etc
Range("OF_TEBC2").Select
Application.CutCopyMode = False
Selection.Copy
Range("D31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Range("O_TPPC").Select
Application.CutCopyMode = False
Selection.Copy
Range("E31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Range("F31").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(RC[-3],RC[-2],RC[-1])"
Range("O_FSP").Select
Selection.Copy
Range("G31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'------
.Range("A31:G31").Copy Sheets("Profit_Loss_Statement").Range("A2")

'????
Do Until Cells(ActiveCell.Row + 1, 1) = ""
If ActiveCell = "" Then
ActiveCell.Offset(1, 1).Select
Else
Cells(ActiveCell.Row + 1, 1).Select
End If
Loop
Cells(ActiveCell.Row + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Sheets("Orders").Range("A31:G31").ClearContents

' Range("ID").Select
Application.CutCopyMode = False


With Application
.ScreenUpdating =true
.EnableEvents =true
End With

End Sub


--
Don Guillett
SalesAid Software

"Gene" wrote in message
...
Can't find my original post. Thank you to all who provided input to the
original post. Here is what I currently use (called from a toolbar):
Sub SelectItem()
'
' SelectItem Macro
' Macro recorded 05/21/2007 by EuGene C. White, CNA
'
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Sheets("Orders").Select
Range("ID").Select
Selection.Copy
Range("A31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
' Insert code for date here?
Range("B31").Select
ActiveCell.FormulaR1C1 = "=NOW()"
Range("O_STSC").Select
Application.CutCopyMode = False
Selection.Copy
Range("C31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Range("O_TEBC2").Select
Application.CutCopyMode = False
Selection.Copy
Range("D31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Range("O_TPPC").Select
Application.CutCopyMode = False
Selection.Copy
Range("E31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Range("F31").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(RC[-3],RC[-2],RC[-1])"
Range("O_FSP").Select
Selection.Copy
Range("G31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A31:G31").Select
Selection.Copy
Sheets("Profit_Loss_Statement").Select
Range("A2").Select
Do Until Cells(ActiveCell.Row + 1, 1) = ""

If ActiveCell = "" Then
ActiveCell.Offset(1, 1).Select
Else
Cells(ActiveCell.Row + 1, 1).Select
End If
Loop
Cells(ActiveCell.Row + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Sheets("Orders").Select
Range("A31:G31").Select
Selection.ClearContents
Range("ID").Select
Application.CutCopyMode = False
End Sub

Might not be the best solution, but it works. I have not done any Excel
VBA
before, just Word and VBScript.
/s/ Gene