0

I got a simple code that do if value if lass then X wait one hour else continue the loop-basically the code need to run for a hole day.

the thing is that when the code is in the wait line i cant use the excel at all. there is a way to solve this issue ? Im adding part of the code

    For i = 1 To 3
Set OutMail = OutApp.createitem(0)
LastRefHour = Cells(2, 1).Value
HourNow = Hour(Now())
Set rng = Sheets("Sheet1").Range("D2:G9").SpecialCells(xlCellTypeVisible)

If (LastRefHour < HourNow) Then

    ActiveWorkbook.Connections("Monitor-Test").Refresh
    Application.CalculateUntilAsyncQueriesDone
    If Not Application.CalculationState = xlDone Then
    DoEvents
    End If

Cells(1, 1).Copy
Cells(2, 1).PasteSpecial xlPasteValues

Else:

    Application.Wait (Now + TimeValue("00:59:00"))


End If
David_12
  • 17
  • 1
  • 4

1 Answers1

2

I'd suggest to use Timer function (MSDN).

Here's how to use it:

Option Explicit

Sub RunCodeInIntervalMode()
Dim StartTime As Single, FinishTime As Single
'i decided to set below variable for short interval of time, 
'because this is only an example
Const WaitTime As Integer = 5 'in second
Dim i As Integer 'counter

'clear entire range
ThisWorkbook.Worksheets(1).Cells.ClearContents

'define finish time
FinishTime = Timer + 30
Do
    'define start time
    StartTime = Timer
    'increase counter
    i = i + 1
    'run procedure
    DisplayTime i, StartTime, FinishTime
    'enable to work in Worksheet in between next run
    Do While Timer < StartTime + WaitTime
        DoEvents
    Loop
Loop While Timer < FinishTime

End Sub

''let's say below procedure is your procedure
Sub DisplayTime(ByVal step As Integer, ByVal currTime As Single, ByVal finTime As Single)

    With ThisWorkbook.Worksheets(1)
        .Range("A1") = step
        .Range("B1") = currTime
        .Range("C1") = finTime
    End With
End Sub

I hope you've got an idea how to achieve that now.

Maciej Los
  • 8,468
  • 1
  • 20
  • 35