title: How to prevent a macro from freezing / turning white the Excel window?
body: <p>So at work I am working on a macro/UserForm in Excel for someone. It works great (I think) and does exactly what it needs to do and takes under 1 minute to run, going through ~70k cells and organizing them. Now I was wondering if there was a way to slow it down so that Excel does not go into "Not Responding" mode while it runs. It would just be better so people that need to use the macro don't freak out when it freezes. And it would be best if there was a solution in VBA so people don't have to worry about it and it works perfectly the first time.</p>
  
  <p><strong>About the Macro</strong></p>
  
  <p>The data is a bunch of numbers that need to be put in one column, and that the 14 (normally 14) columns before it label each number with dates and other data. All size references and sheet names needs to be from a UserForm so I don't know the name of the sheets or size ahead of time this resulted in some weird code at the beginning of my loop.</p>
  
  <p>Also, if you see anyway to make my code more efficient that would be greatly appreciated!</p>
  
  <p><strong>The Code</strong></p>
  
  <pre><code>Private Sub UserForm_Initialize()
  
      'This brings up the data for my dropdown menu to pick a sheet to pull data from
      For i = 1 To Sheets.Count
          combo.AddItem Sheets(i).name
      Next i
  
  End Sub
  
  Private Sub OK_Click()
  
      Unload AutoPivotusrfrm
  
      'Declaring All of my Variables that are pulled from Userform
  
      Dim place As Long
  
      Dim x1 As Integer
      x1 = value1.Value
      Dim x2 As Integer
      x2 = value2.Value
      Dim x3 As Integer
      x3 = value4.Value
      Dim y1 As Integer
      y1 = value3.Value
  
      Dim copyRange As Variant
  
      Dim oldname As String
      oldsheetname = combo.Text
  
      Dim newname As String
      newname = newsheetname.Text
  
      Sheets.Add.name = newsheetname
  
      'Labels for section one
      Worksheets(CStr(oldsheetname)).Activate
      copyRange = Range(Cells(x1, x1), Cells(x1 + 1, x3 - 1)).Value
      Worksheets(CStr(newsheetname)).Activate
      Range(Cells(x1, x1), Cells(x1 + 1, x3 - 1)).Value = copyRange
      place = x1 + 2
      x1 = place
  
  
      'Looping through the cells copying data
      For i = x1 To x2
      'This was the only way to copy multiple cells at once other ways it would just error
          Worksheets(CStr(oldsheetname)).Activate
          copyRange = Range(Cells(i + 3 - x1, x1 - 2), Cells(i + 3 - x1, x3 - 1)).Value
          Worksheets(CStr(newsheetname)).Activate
          For j = x3 To y1
              Range(Cells(place, 1), Cells(place, x3 - 1)).Value = copyRange
              Cells(place, x3) = Sheets(CStr(oldsheetname)).Cells(1, j)
              Cells(place, x3 + 1) = Sheets(CStr(oldsheetname)).Cells(2, j)
              Cells(place, x3 + 2) = Sheets(CStr(oldsheetname)).Cells(i + 2, j)
              place = place + 1
          Next j
      Next i
  
  End Sub
  
  Private Sub cancel_Click()
  
      Unload AutoPivotusrfrm
  
  End Sub
  </code></pre>