Add Timer to Code

**Shawn Michaels** · 10-06-2012, 04:14 PM

Hello Experts !

I am executing this code:

Sub AutoTaketoRelevantSheet()
'
' AutoTaketoRelevantSheet Macro
'

'
    Application.ScreenUpdating = False
    Sheets("Names").Select
    Range("A1").Select
    Selection.AutoFilter
    Range("B1").Select
    ActiveSheet.Range("A:C").AutoFilter Field:=2, Criteria1:="Green"
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Green Team").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    Sheets("Names").Select
    Application.CutCopyMode = False
    Range("B1").Select
    ActiveSheet.Range("A:C").AutoFilter Field:=2, Criteria1:="Blue"
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Blue Team").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    Sheets("Names").Select
    Application.CutCopyMode = False
    Range("B1").Select
    ActiveSheet.Range("A:C").AutoFilter Field:=2, Criteria1:="=Red"
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Red Team").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    Sheets("Names").Select
    Application.CutCopyMode = False
    Range("B1").Select
    ActiveSheet.Range("A:C").AutoFilter Field:=2
    Range("A1").Select
    Selection.AutoFilter
    Application.ScreenUpdating = True
End Sub

How can I add timer to this code ? I searched a site and it showed a code, which has Start = Time after Application.ScreenUpdating = False
and at the end, it has Next, then next line, MsgBox Timer - Start & "Seconds".

I added this to my above code but didn't work ?

Can an expert please show me how to add time code to above code ?

Thanks

**john55** · 10-06-2012, 04:32 PM

try this

Dim t As Date
   t = Now()
Application.ScreenUpdating = False
'
'your code
'
'
Sheets("Names").[i1] = Format(Now() - t, "hh:mm:ss")
MsgBox "" & Format(Sheets("Names").[i1], "hh:mm:ss")

end sub

**Shawn Michaels** · 10-06-2012, 04:40 PM

Hi John !

Thanks for your kind reply.

Its giving an error: Invalid outside procedure

And I think its a time code. I saw this, which was at the end of the code:

MsgBox Timer - Start & "Seconds"

This shows a message box, that how many seconds it took from execution to results of pressing the "run the macro".

Do you any idea about this code ?

Thanks for your help.

**Artik_PL** · 10-06-2012, 09:46 PM

For example:

Sub AutoTaketoRelevantSheet()
  Dim Tm1 As Single, Tm2 As Single
  Dim Tm3 As Single, Tm4 As Single
  Dim Tm5 As Single
  Dim Msg As String
  
    Application.ScreenUpdating = False
    
    Tm1 = Timer
    
    Sheets("Names").Select
    Range("A1").Select
    Selection.AutoFilter
    Range("B1").Select
    ActiveSheet.Range("A:C").AutoFilter Field:=2, Criteria1:="Green"
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Green Team").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    
    Tm2 = Timer
    
    Sheets("Names").Select
    Application.CutCopyMode = False
    Range("B1").Select
    ActiveSheet.Range("A:C").AutoFilter Field:=2, Criteria1:="Blue"
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Blue Team").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    
    Tm3 = Timer
    
    Sheets("Names").Select
    Application.CutCopyMode = False
    Range("B1").Select
    ActiveSheet.Range("A:C").AutoFilter Field:=2, Criteria1:="=Red"
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Red Team").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    
    Tm4 = Timer
    
    Sheets("Names").Select
    Application.CutCopyMode = False
    Range("B1").Select
    ActiveSheet.Range("A:C").AutoFilter Field:=2
    Range("A1").Select
    Selection.AutoFilter
    
    Tm5 = Timer
    
    Application.ScreenUpdating = True
    
    Msg = "Time 1: " & String(2, vbTab) & Format(Tm2 - Tm1, "0.000 sec") & vbCr
    Msg = Msg & "Time 2: " & String(2, vbTab) & Format(Tm3 - Tm2, "0.000 sec") & vbCr
    Msg = Msg & "Time 3: " & String(2, vbTab) & Format(Tm4 - Tm3, "0.000 sec") & vbCr
    Msg = Msg & "Time 4: " & String(2, vbTab) & Format(Tm5 - Tm4, "0.000 sec") & vbCr
    Msg = Msg & "Total time: " & vbTab & Format(Tm5 - Tm1, "0.000 sec") & vbCr
    
    MsgBox Msg
End Sub

Artik