Vbalearner85
Board Regular
- Joined
- Jun 9, 2019
- Messages
- 139
- Office Version
- 2016
- Platform
- Windows
Hi Members,
I have the below macro which I am using for my Timer/values copy purpose and has served my purpose well until now. Off late I am seeing some speed Issues and excel goes to "Not responding" several times. In combination, I am using the "Timer5" macro - Application. Ontine method (used in below macro) to loop below macro every second.
Looking for suggestions as to if I can optimize the macro for speed or if I am doing something wrong fundamentally.
Please note that:-
1. the conditions in the said macro used Range("B2:B173") are met for most of the cells per second and macro is doing some busy work.
2. Some other Copy. Paste Data macros are also used to copy some data per second from one sheet to another (1 second Loop) and these macros have synced well historically.
I have the below macro which I am using for my Timer/values copy purpose and has served my purpose well until now. Off late I am seeing some speed Issues and excel goes to "Not responding" several times. In combination, I am using the "Timer5" macro - Application. Ontine method (used in below macro) to loop below macro every second.
Looking for suggestions as to if I can optimize the macro for speed or if I am doing something wrong fundamentally.
Please note that:-
1. the conditions in the said macro used Range("B2:B173") are met for most of the cells per second and macro is doing some busy work.
2. Some other Copy. Paste Data macros are also used to copy some data per second from one sheet to another (1 second Loop) and these macros have synced well historically.
VBA Code:
Sub Timer()
If Time >= ThisWorkbook.Sheets("Control").Range("E17").Value2 Then Exit Sub
Dim Cell As Range
Application.ScreenUpdating = False
For Each Cell In Workbooks("Dater").Sheets("Timer").Range("B2:B173")
If Cell.Value <> Cell.Offset(0, 9).Value Then
Cell.Offset(0, 7).Value = Now
Cell.Offset(0, 9).Value = Cell.Value
Cell.Offset(0, 8).Value = Cell.Offset(0, 4).Value
Cell.Offset(0, 10).Value = Cell.Offset(0, 10).Value + 1
Cell.Offset(0, 24).Value = 1
Cell.Offset(0, 27).Value = 0
Cell.Offset(0, 28).Value = 0
ElseIf Cell.Offset(0, 10).Value <> Cell.Offset(0, 14).Value And Cell.Value = "LR" Then
Cell.Offset(0, 11).Value = Cell.Offset(0, 11).Value + 1
ElseIf Cell.Offset(0, 10).Value <> Cell.Offset(0, 14).Value And Cell.Value = "NR" Then
Cell.Offset(0, 12).Value = Cell.Offset(0, 12).Value + 1
ElseIf Cell.Offset(0, 10).Value <> Cell.Offset(0, 14).Value And Cell.Value = "HR" Then
Cell.Offset(0, 13).Value = Cell.Offset(0, 13).Value + 1
ElseIf Cell.Offset(0, 25).Value <> Cell.Offset(0, 26).Value Then
Cell.Offset(0, 23).Value = Cell.Offset(0, 2).Value
Cell.Offset(0, 24).Value = Cell.Offset(0, 24).Value + 1
Cell.Offset(0, 29).Value = Now
ElseIf Cell.Offset(0, 2).Value < Cell.Offset(0, 27).Value Then
Cell.Offset(0, 27).Value = Cell.Offset(0, 2).Value
ElseIf Cell.Offset(0, 2).Value > Cell.Offset(0, 28).Value Then
Cell.Offset(0, 28).Value = Cell.Offset(0, 2).Value
End If
Next
Columns("I:I").EntireColumn.AutoFit
Call Timer5
Application.ScreenUpdating = True
End Sub