Sheet to automatically update

[danjuma]

Hello all. Below is a VBA macro code I recorded (manually sorting data in range A2:F29 based on the largest to smallest in range F2:F29). I would be most grateful if someone could amend it so that this is done automatically by excel (sort out the data) every say 5 secs. Many thanks

Sub AutoSort()'
' AutoSort Macro
'
' Keyboard Shortcut: Ctrl+p
'
    Range("A2:F29").Select
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add2 Key:=Range("F2:F29") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet2").Sort
        .SetRange Range("A2:F29")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("G3").Select
End Sub

 

[DanteAmor]

Run the code Start_each.
If you want to stop the execution, execute the code Stop_each

Try this

Dim vNow  '<---- At the beginning of the entire code


Sub [COLOR=#0000ff]AutoSort[/COLOR]() '
  ' AutoSort Macro
  ' Keyboard Shortcut: Ctrl+p
  '
  With ActiveWorkbook.Worksheets("Sheet2").Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range("F2:F29"), SortOn:=xlSortOnValues, _
      Order:=xlDescending, DataOption:=xlSortNormal
    .SetRange Range("A2:F29")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
End Sub


Sub [COLOR=#008000]Start_each[/COLOR]()
  Call AutoSort
  vNow = Now + TimeValue("00:00:05")
  Application.OnTime vNow, "Start_each"
End Sub


Sub [COLOR=#ff0000]Stop_each[/COLOR]()
  On Error Resume Next
  Application.OnTime vNow, "Start_each", , False
End Sub

 

[danjuma]

Run the code Start_each.
If you want to stop the execution, execute the code Stop_each

Try this

Dim vNow  '<---- At the beginning of the entire code


Sub [COLOR=#0000ff]AutoSort[/COLOR]() '
  ' AutoSort Macro
  ' Keyboard Shortcut: Ctrl+p
  '
  With ActiveWorkbook.Worksheets("Sheet2").Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range("F2:F29"), SortOn:=xlSortOnValues, _
      Order:=xlDescending, DataOption:=xlSortNormal
    .SetRange Range("A2:F29")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
End Sub


Sub [COLOR=#008000]Start_each[/COLOR]()
  Call AutoSort
  vNow = Now + TimeValue("00:00:05")
  Application.OnTime vNow, "Start_each"
End Sub


Sub [COLOR=#ff0000]Stop_each[/COLOR]()
  On Error Resume Next
  Application.OnTime vNow, "Start_each", , False
End Sub

Works fine. Many thanks sir. Much obliged.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.