title: Break sub-routine on Excel button while Excel is locked in procedure
body: <p>I have written a VBA procedure (initiated in Excel 2010) which loops around an array containing different Excel files. The loop opens the file, refreshes the data, saves and closes the file for each item in the array. The process can take up to 90 minutes to complete, so I wanted a safe break routine which will stop the process when the current iteration is complete. </p>
  
  <p>I contained the code in a do-while loop with a boolean initialized to False. I created a Stop button in Excel which sets the boolean variable to True when pressed so the do while condition will be met and stop the procedure.</p>
  
  <p>The stop button is based in the same excel file which initializes the procedure of opening and closing excel files. <em>This means that the excel instance locks, so a user cannot press the break button and halt the procedure.</em></p>
  
  <p>How can I access the stop button? Or is there an alternative way to initiate the break? </p>
  
  <p>My Code - Added 06/06/2014 15:12</p>
  
  <pre><code>Sub Refresh_Weekly()
  failedIndex = 0
  'DoEvents
  'Refresh_StandardWeekly ' module 2
  'Refresh_NonStandardWeekly ' module 4
  Refresh_CRIS ' module 3
  
  If StopMsg &lt;&gt; "" Then
      MsgBox StopMsg
  
      ElseIf failedIndex = 0 Then
          MsgBox "All Weekly Pivots refreshed"
      Else
          For x = 0 To failedIndex - 1
          OutputMsg = OutputMsg + Failed(x) &amp; ", "
          Next x
      MsgBox "Pivots which failed to refresh:" &amp; OutputMsg
  End If
  Erase Failed
  OutputMsg = ""
  End Sub
  </code></pre>
  
  <hr>
  
  <pre><code>Sub Refresh_CRIS()
  
  Dim routepath As String
  routepath = "\\nch\dfs\SharedArea\Private\BIS\Groups\KPI-Group\Pivots\"
  
  ChDir routepath
  
  Dim CRISPiv As Variant 'Includes Dailies
  Dim i
  Dim errorText As String
  Dim x
  Dim objXL As Excel.Application
  Set objXL = CreateObject("Excel.Application")
  UserForm1.Show vbModeless
  Ref = True
  
  CRISPiv = Array("Waiting-List-Diagnostic.xls", "Cancer_PTL Position.xls")
  
  Do While Ref
  DoEvents
  
  For Each i In CRISPiv
      If File_Exists(routepath &amp; i) Then
          If isFileOpen(i) = True Then
          errorText = i
          Failed(failedIndex) = errorText
          failedIndex = failedIndex + 1
          Else
  
          objXL.Visible = False
          objXL.Workbooks.Open Filename:=routepath &amp; i
              If objXL.ActiveWorkbook.ReadOnly = False Then
              objXL.ActiveWorkbook.RefreshAll
              objXL.Application.CalculateFull
              objXL.Application.DisplayAlerts = False
              objXL.ActiveWorkbook.Save
              objXL.Application.DisplayAlerts = True
              objXL.Quit
  
              Else
              errorText = i
              Failed(failedIndex) = errorText
              failedIndex = failedIndex + 1
              objXL.Application.DisplayAlerts = False
              objXL.Quit
              Application.DisplayAlerts = True
              End If
          End If
      Else
      errorText = i
      Failed(failedIndex) = errorText
      failedIndex = failedIndex + 1
      End If
  
  Next i
  Ref = False
  Loop
  
  Unload UserForm1
  
  Exit Sub
  
  Resume Next
  
  End Sub
  </code></pre>
  
  <hr>
  
  <pre><code>Public RefStop As Boolean
  Public StopMsg As String
  
  Sub Refresh_Stop_Test_Click()
  
  Ref = False
  StopMsg = "Refresh Cancelled"
  
  End Sub
  </code></pre>
  
  <hr>
  
  <p>A highly altered version of my code is below to try and match @David's code as best I could and it still doesn't work. I needed to add boo = False after my For each statement finishes otherwise it would loop to infinity. I also added a simple msgbox to test if the button works. Everything else is the same but the form won't allow me to press the button. If I press where the button is multiple times (think frustrated mega clicking) when the code finishes and pops up with the "Fine" msg it beeps that number of times so it obviously isn't dealing with my input.</p>
  
  <p>Code:</p>
  
  <p>Public boo As Boolean</p>
  
  <pre><code>Sub Refresh_CRIS()
  
  Dim objXL As Excel.Application
  Dim i, CRISPiv
  Set objXL = CreateObject("Excel.Application")
  
  CRISPiv = Array("C:/Temp/test/Book1.xlsm", "C:/Temp/test/Book2.xlsm")
  UserForm1.Show vbModeless
  
  boo = True
  
  Do While boo
      DoEvents
      For Each i In CRISPiv
          objXL.Visible = False
          objXL.Workbooks.Open i
          objXL.ActiveWorkbook.Save
          objXL.Quit
      Next
  boo = False
  
  Loop
  
  Unload UserForm1
  If StopMsg &lt;&gt; "" Then
  MsgBox StopMsg
  
  Else: MsgBox "Fine"
  End If
  </code></pre>
  
  <h2>    End Sub</h2>
  
  <p>Dropbox link to my Excel control file: </p>
  
  <p><a href="https://www.dropbox.com/sh/n0jec8h0edftur6/AADlRnvnzuSpYMNvMUxwORRva" rel="nofollow">Excel Control file</a></p>