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
(E-Mail Removed)
"Gene" <(E-Mail Removed)> wrote in message
news:80250D76-3F03-43B3-93E3-(E-Mail Removed)...
> 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
Similar Threads
