MrExcel Publishing
Your One Stop for Excel Tips & Solutions

Please help with Macro delaring variables


Posted by Ken on January 28, 2002 1:24 PM

Please help with this macro and tell me how to set the variables correctly and make it run faster.

Sub AddPO()
Dim Lastsheetname As Variant
Application.ScreenUpdating = False
Lastsheetname = Sheets(Sheets.Count).Name
Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Lastsheetname + 1
Sheets(Sheets.Count).Range("D8") = Sheets(Sheets.Count).Name
Sheets(Sheets.Count).Range("A44:F70").Select
Selection.ClearContents
With Selection.Interior
.ColorIndex = 2
End With
Sheets(Sheets.Count).Range("D10").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Sheets(Sheets.Count).Range("D11").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+1"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Sheets(Sheets.Count).Range("C45").Select
Application.ScreenUpdating = True
End Sub

Thanks
Ken


Posted by Juan Pablo G. on January 28, 2002 1:38 PM

Try, repeat, TRY, this one.

Sub AddPO()
Dim Lastsheetname As Variant
Dim WS As Worksheet
Application.ScreenUpdating = False

Lastsheetname = Sheets(Sheets.Count).Name

Set WS = Sheets(Sheets.Count).Copy(After:=Sheets(Sheets.Count))
With WS
.Name = Lastsheetname + 1
.Range("D8") = .Name
With .Range("A44:F70")
.ClearContents
.Interior.ColorIndex = 2
End With
.Range("D10") = Date
.Range("D11").FormulaR1C1 = "=R[-1]C+1"
.Range("D11") = .Range("D11")
.Range("C45").Select
End With
Application.ScreenUpdating = True
End Sub


Juan Pablo G.

Posted by Ivan F Moala on January 28, 2002 2:11 PM

Run these 2 ti see the diff.
1st one is your code slight adj
2nd one is an amended version
Basically diff is it doesn't select the
ranges...cuts down unnecessary coding using
with statement........plus uses VBA Date functions
instead of the application worksheet functions >
cuts down on extra processing eg copy | paste etc

HTH


Ivan


Approx diff in time 100% faster

Option Explicit
Dim start

Sub AddPO()
Dim Lastsheetname As Variant
start = Timer
Application.ScreenUpdating = False

Lastsheetname = Sheets(Sheets.Count).Name
Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Lastsheetname & 1
Sheets(Sheets.Count).Range("D8") = Sheets(Sheets.Count).Name
Sheets(Sheets.Count).Range("A44:F70").Select
Selection.ClearContents
With Selection.Interior
.ColorIndex = 2
End With
Sheets(Sheets.Count).Range("D10").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Sheets(Sheets.Count).Range("D11").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+1"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Sheets(Sheets.Count).Range("C45").Select
Application.ScreenUpdating = True
[a1] = Timer - start
End Sub

Sub AddPO_Amd()
Dim Lastsheetname As Variant
start = Timer
Application.ScreenUpdating = False

Lastsheetname = Sheets(Sheets.Count).Name
Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
With ActiveSheet
.Name = Lastsheetname & 1
.Range("D8") = Sheets(Sheets.Count).Name
.Range("A44:F70").ClearContents
.Range("A44:F70").Interior.ColorIndex = 2
.Range("D10") = Date
.Range("D11") = Date + 1
.Range("C45").Select
End With

Application.ScreenUpdating = True

[a1] = Timer - start

End Sub