add a delay to this macro and pause it if it gets to 6pm?

[tonywatsonhelp]

Hi Everyone,

I have this macro that runs on (I think its called a loop?)

now it works great but for reasons that are hard to describe (lets call then office politics) I need it to do the following,
each time it gets to here "Next Cl" I would like it to wait 90 seconds before proceeding please.

but also before it proceeds I'd like it to check if its 6pm or later and if it is then pause the macro
and messagebox me "Macro paused do you want to continue?"

the code is below,
please help if you can as I cant go home until i've sorted this out

Thanks

Tony

Sub Add_All_Condition_Sheets1() 'add sheets in a list
   Dim Cl As Range
   
   Application.ScreenUpdating = False
   With Sheets("Key Risks")

'      For Each Cl In .Range("H1", .Range("H" & Rows.Count).End(xlUp))
      For Each Cl In .Range("B2:B56")
         Sheets("Master").Copy , Sheets(Sheets.Count)
         ActiveSheet.Name = Cl.Value
         ActiveSheet.Range("AF2").Value = Cl.Offset(, 1).Value
      Next Cl ' SO Here I would like it to wait 90 seconds before proceeding please
'then here I need it to check that its not 6pm or later, if it is, the pause the macro
create a pop up box that says "Macro Pause Continue?" and a yes no Box
if yes then it continues if no it just closes down and exits.




   End With
   Application.ScreenUpdating = True
End Sub

 

[BSALV]

with application.ontime !

 

[BSALV]

normally you something like this with application.ontime, but you asked to "wait" so ...

Sub Add_All_Condition_Sheets1()                                 'add sheets in a list

     Dim Cl    As Range

     Do 'start infinite loop
          Application.ScreenUpdating = False
          With Sheets("Key Risks")

     '      For Each Cl In .Range("H1", .Range("H" & Rows.Count).End(xlUp))
               For Each Cl In .Range("B2:B56")
                    Sheets("Master").Copy , Sheets(Sheets.Count)
                    ActiveSheet.Name = Cl.Value
                    ActiveSheet.Range("AF2").Value = Cl.Offset(, 1).Value
               Next Cl

               Application.Wait Now + TimeSerial(0, 0, 90)      'wait 90 sec
               If Now - Date >= TimeSerial(18, 30, 0) Then
                    answ = MsgBox("macro pause/continu", vbYesNo, UCase("After 18:30 PM"))
                    If answ <> vbYes Then Exit Sub              'no = stop and exit
               End If
          End With
          Application.ScreenUpdating = True
     Loop

End Sub

 

[Strithken]

I’d include Application.ScreenUpdating = True before Exit Sub.