Hiya

I have a looping sub that takes 5 cells and every 0.2 seconds adds to their
values, dealing with one at each successive 0.2 second interval , so that by
the end of each second every cell has been visited and increased by the
macro once. In other words at 0.2 seconds A1 is increased, at 0.4 seconds B1
is increased, 0.6 seconds C1 is increased 0.8 seconds D1 is increased and
then at 1 second E1 is increased. And then it all loops.

The problem I have is that I want to increase the cell values by the value
of just one each time. By using the = instruction it increases each cell by
many hundreds on each loop cycle (except for the last one in the series.)
However if I just use = instead, the system ignores the instruction
altogether - it doesn't seem sensitive enough to register.

Any solutions involving lots of do loops disrupt the timer function
altogether, which is very vulnerable to any system resource reallocations.

Does anyone see a simple elegant solution that doesn't require heavier
processing? Many thanks.

Sub count()
Range("A1") = 0
Range("B1") = 0
Range("C1") = 0
Range("D1") = 0
Range("E1") = 0

tim1 = Timer 'sets the time the process started
Do
tim2 = Timer 'sets current time
diff = tim2 - tim1 'derives the number of seconds since process started,
refreshing on every loop

If diff = 1 Then
Range("e1") = Range("e1") + 1
tim1 = Timer 'restarts process by resetting number of seconds since
process started to zero

ElseIf diff = 0.8 Then
Range("d1") = Range("d1") + 1

ElseIf diff = 0.6 Then
Range("c1") = Range("C1") + 1

ElseIf diff = 0.4 Then
Range("b1") = Range("b1") + 1

ElseIf diff = 0.2 Then
Range("a1") = Range("a1") + 1

End If

Loop

End Sub

Hi Teepee,

If you use the following you'll see the number of times the procedure
is looping each time it is run (recorded in column G & only up to
where E1 = 1). So there isn't an update being made every 0.2 seconds,
but every time the loop is passed through.


Option Explicit
Sub count()
Dim tim1, tim2, diff As Double
Dim lCounter As Long

Range("A1:E1,G:G") = ""

tim1 = Timer 'sets the time the process started

Do Until Range("E1") = 1
tim2 = Timer
diff = tim2 - tim1
If diff = 1 Then
Range("e1") = Range("e1") + 1
tim1 = Timer
ElseIf diff = 0.8 Then
Range("d1") = Range("d1") + 1
ElseIf diff = 0.6 Then
Range("c1") = Range("C1") + 1
ElseIf diff = 0.4 Then
Range("b1") = Range("b1") + 1
ElseIf diff = 0.2 Then
Range("a1") = Range("a1") + 1
End If
Range("G1").Offset(lCounter, 0) = lCounter + 1
lCounter = lCounter + 1
Loop
End Sub


HtH,
JF.

On 31 Dec, 09:31, "teepee" wrote:
Hiya

I have a looping sub that takes 5 cells and every 0.2 seconds adds to their
values, dealing with one at each successive 0.2 second interval , so that by
the end of each second every cell has been visited and increased by the
macro once. In other words at 0.2 seconds A1 is increased, at 0.4 seconds B1
is increased, 0.6 seconds C1 is increased 0.8 seconds D1 is increased and
then at 1 second E1 is increased. And then it all loops.

The problem I have is that I want to increase the cell values by the value
of just one each time. By using the = instruction it increases each cell by
many hundreds on each loop cycle (except for the last one in the series.)
However if I just use = instead, the system ignores the instruction
altogether - it doesn't seem sensitive enough to register.

Any solutions involving lots of do loops disrupt the timer function
altogether, which is very vulnerable to any system resource reallocations..

Does anyone see a simple elegant solution that doesn't require heavier
processing? Many thanks.

Sub count()
Range("A1") = 0
Range("B1") = 0
Range("C1") = 0
Range("D1") = 0
Range("E1") = 0

tim1 = Timer * *'sets the time the process started
Do
tim2 = Timer * 'sets current time
diff = tim2 - tim1 * 'derives the number of seconds since process started,
refreshing on every loop

If diff = 1 Then
Range("e1") = Range("e1") + 1
tim1 = Timer * 'restarts process by resetting number of seconds since
process started to zero

ElseIf diff = 0.8 Then
Range("d1") = Range("d1") + 1

ElseIf diff = 0.6 Then
Range("c1") = Range("C1") + 1

ElseIf diff = 0.4 Then
Range("b1") = Range("b1") + 1

ElseIf diff = 0.2 Then
Range("a1") = Range("a1") + 1

End If

*Loop

End Sub

Brilliant thanks

"Joshua Fandango" wrote in message
...
Hi Teepee,

If you use the following you'll see the number of times the procedure
is looping each time it is run (recorded in column G & only up to
where E1 = 1). So there isn't an update being made every 0.2 seconds,
but every time the loop is passed through.


Option Explicit
Sub count()
Dim tim1, tim2, diff As Double
Dim lCounter As Long

Range("A1:E1,G:G") = ""

tim1 = Timer 'sets the time the process started

Do Until Range("E1") = 1
tim2 = Timer
diff = tim2 - tim1
If diff = 1 Then
Range("e1") = Range("e1") + 1
tim1 = Timer
ElseIf diff = 0.8 Then
Range("d1") = Range("d1") + 1
ElseIf diff = 0.6 Then
Range("c1") = Range("C1") + 1
ElseIf diff = 0.4 Then
Range("b1") = Range("b1") + 1
ElseIf diff = 0.2 Then
Range("a1") = Range("a1") + 1
End If
Range("G1").Offset(lCounter, 0) = lCounter + 1
lCounter = lCounter + 1
Loop
End Sub


HtH,
JF.

On 31 Dec, 09:31, "teepee" wrote:
Hiya

I have a looping sub that takes 5 cells and every 0.2 seconds adds to
their
values, dealing with one at each successive 0.2 second interval , so that
by
the end of each second every cell has been visited and increased by the
macro once. In other words at 0.2 seconds A1 is increased, at 0.4 seconds
B1
is increased, 0.6 seconds C1 is increased 0.8 seconds D1 is increased and
then at 1 second E1 is increased. And then it all loops.

The problem I have is that I want to increase the cell values by the value
of just one each time. By using the = instruction it increases each cell
by
many hundreds on each loop cycle (except for the last one in the series.)
However if I just use = instead, the system ignores the instruction
altogether - it doesn't seem sensitive enough to register.

Any solutions involving lots of do loops disrupt the timer function
altogether, which is very vulnerable to any system resource reallocations.

Does anyone see a simple elegant solution that doesn't require heavier
processing? Many thanks.

Sub count()
Range("A1") = 0
Range("B1") = 0
Range("C1") = 0
Range("D1") = 0
Range("E1") = 0

tim1 = Timer 'sets the time the process started
Do
tim2 = Timer 'sets current time
diff = tim2 - tim1 'derives the number of seconds since process started,
refreshing on every loop

If diff = 1 Then
Range("e1") = Range("e1") + 1
tim1 = Timer 'restarts process by resetting number of seconds since
process started to zero

ElseIf diff = 0.8 Then
Range("d1") = Range("d1") + 1

ElseIf diff = 0.6 Then
Range("c1") = Range("C1") + 1

ElseIf diff = 0.4 Then
Range("b1") = Range("b1") + 1

ElseIf diff = 0.2 Then
Range("a1") = Range("a1") + 1

End If

Loop

End Sub

Add this code to one code module

Option Explicit

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function SetTimer Lib "user32" _
(ByVal hWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32" _
(ByVal hWnd As Long, _
ByVal nIDEvent As Long) As Long

Private CountIndex As Long
Private WindowsTimer As Long


Public Function cbkRoutine(ByVal Window_hWnd As Long, _
ByVal WindowsMessage As Long, _
ByVal EventID As Long, _
ByVal SystemTime As Long) As Long

CountIndex = CountIndex + 1
If CountIndex 5 Then CountIndex = 1
With Range("A1:E1").Cells(1, CountIndex)

.Value = .Value + 1
End With

End Function

Sub StartTimer()
Range("A1") = 0
Range("B1") = 0
Range("C1") = 0
Range("D1") = 0
Range("E1") = 0

fncWindowsTimer 200, WindowsTimer '1/5th sec
End Sub

Sub StopTimer()
fncStopWindowsTimer
End Sub


Public Function fncWindowsTimer(TimeInterval As Long, WindowsTimer As Long)
As Boolean
WindowsTimer = 0
'if Excel2000 or above use the built-in AddressOf operator to
'get a pointer to the callback function
If Val(Application.Version) 8 Then
WindowsTimer = SetTimer(hWnd:=FindWindow("XLMAIN",
Application.Caption), _
nIDEvent:=0, _
uElapse:=TimeInterval, _
lpTimerFunc:=AddrOf_Callback_Routine)
Else 'use K.Getz & M.Kaplan function to get a pointer
WindowsTimer = SetTimer(hWnd:=FindWindow("XLMAIN",
Application.Caption), _
nIDEvent:=0, _
uElapse:=TimeInterval, _
lpTimerFunc:=AddrOf("cbkRoutine"))
End If

fncWindowsTimer = CBool(WindowsTimer)

DoEvents

End Function

Public Function fncStopWindowsTimer()
KillTimer hWnd:=FindWindow("XLMAIN", Application.Caption), _
nIDEvent:=0 'WindowsTimer
End Function




and this code to an other, separate code module

Option Explicit

Private Declare Function GetCurrentVbaProject Lib "vba332.dll" _
Alias "EbGetExecutingProj" _
(hProject As Long) As Long

Private Declare Function GetFuncID Lib "vba332.dll" _
Alias "TipGetFunctionId" _
(ByVal hProject As Long, _
ByVal strFunctionName As String, _
ByRef strFunctionID As String) As Long

Private Declare Function GetAddr Lib "vba332.dll" _
Alias "TipGetLpfnOfFunctionId" _
(ByVal hProject As Long, _
ByVal strFunctionID As String, _
ByRef lpfnAddressOf As Long) As Long

'----------------------------------------------------------------------------
Public Function AddrOf(CallbackFunctionName As String) As Long
'----------------------------------------------------------------------------
'AddressOf operator emulator for Office97 VBA
'Authors: Ken Getz and Michael Kaplan
'----------------------------------------------------------------------------
Dim aResult As Long
Dim CurrentVBProject As Long
Dim strFunctionID As String
Dim AddressOfFunction As Long
Dim UnicodeFunctionName As String

'convert the name of the function to Unicode system
UnicodeFunctionName = StrConv(CallbackFunctionName, vbUnicode)

'if the current VBProjects exists...
If Not GetCurrentVbaProject(CurrentVBProject) = 0 Then
'...get the function ID of the callback function, based on its
'unicode-converted name, to ensure that it exists
aResult = GetFuncID(hProject:=CurrentVBProject, _
strFunctionName:=UnicodeFunctionName, _
strFunctionID:=strFunctionID)
'if the function exists indeed ...
If aResult = 0 Then
'...get a pointer to the callback function based on
'the strFunctionID argument of the GetFuncID function
aResult = GetAddr(hProject:=CurrentVBProject, _
strFunctionID:=strFunctionID, _
lpfnAddressOf:=AddressOfFunction)
'if we've got the pointer pass it to the result of the function
If aResult = 0 Then
AddrOf = AddressOfFunction
End If

End If

End If

End Function

'----------------------------------------------------------------------------
Public Function AddrOf_Callback_Routine() As Long
'----------------------------------------------------------------------------
'Office97 VBE does not recognise the AddressOf operator;
'however, it does not raise a compile-error ...
'----------------------------------------------------------------------------
AddrOf_Callback_Routine = vbaPass(AddressOf cbkRoutine)
End Function

'----------------------------------------------------------------------------
Private Function vbaPass(AddressOfFunction As Long) As Long
'----------------------------------------------------------------------------
vbaPass = AddressOfFunction
End Function


Add two buttons to run the StartTimer and StopTimer macros.

--
__________________________________
HTH

Bob

"teepee" wrote in message
...
Hiya

I have a looping sub that takes 5 cells and every 0.2 seconds adds to
their values, dealing with one at each successive 0.2 second interval , so
that by the end of each second every cell has been visited and increased
by the macro once. In other words at 0.2 seconds A1 is increased, at 0.4
seconds B1 is increased, 0.6 seconds C1 is increased 0.8 seconds D1 is
increased and then at 1 second E1 is increased. And then it all loops.

The problem I have is that I want to increase the cell values by the value
of just one each time. By using the = instruction it increases each cell
by many hundreds on each loop cycle (except for the last one in the
series.) However if I just use = instead, the system ignores the
instruction altogether - it doesn't seem sensitive enough to register.

Any solutions involving lots of do loops disrupt the timer function
altogether, which is very vulnerable to any system resource reallocations.

Does anyone see a simple elegant solution that doesn't require heavier
processing? Many thanks.

Sub count()
Range("A1") = 0
Range("B1") = 0
Range("C1") = 0
Range("D1") = 0
Range("E1") = 0

tim1 = Timer 'sets the time the process started
Do
tim2 = Timer 'sets current time
diff = tim2 - tim1 'derives the number of seconds since process started,
refreshing on every loop

If diff = 1 Then
Range("e1") = Range("e1") + 1
tim1 = Timer 'restarts process by resetting number of seconds since
process started to zero

ElseIf diff = 0.8 Then
Range("d1") = Range("d1") + 1

ElseIf diff = 0.6 Then
Range("c1") = Range("C1") + 1

ElseIf diff = 0.4 Then
Range("b1") = Range("b1") + 1

ElseIf diff = 0.2 Then
Range("a1") = Range("a1") + 1

End If

Loop

End Sub