title: How to speed up macros/hide screen while code is running
body: <p>I have a series of macros that format a single sheet and import values from hardcoded arrays if a match is found.  The code is well commented.  Macros are called in the order that they are listed.  I would like your opinion on how to speed up the code or hide the sheet from view, so that the user doesn’t see any manipulation on the screen while Macro is running.  Thank you very much.</p>
  
  <pre><code>    Sub MacroA()
      '
      ' addcolumn Macro
      '
  
          Dim sht As Worksheet
          Dim LastRow As Long
  
          Set sht = ThisWorkbook.Worksheets("QC")
  
          LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
  
         Application.EnableEvents = False
         Application.ScreenUpdating = False
         '~~~~~&gt; error checking
  
                     If Sheet2.Range("A2").Value = "" Then
                  'MsgBox " There are no QC samples on this run"
                  Exit Sub
                  End If
  
          Worksheets("QC").Select
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~copy down value from A2
  
          sht.Range("A2").Value2 = "HD200_QC"
          'copy QC name down
          Range("A2").Select
          Selection.Copy
          Range("A2:A" &amp; LastRow).Select
          ActiveSheet.Paste
       '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
          Columns(3).EntireColumn.Delete 'removes extra column for interpretation
  
          Columns("H:H").Select '\\add one column
          Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  
          Columns("G:G").Select 'convert formulas to values
          Selection.Copy
          Columns("G:G").Select
          Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
              :=False, Transpose:=False
          With sht
  
          .Range("A1").Value2 = "QC"
          .Range("G1").Value2 = "AAchange"
          .Range("H1").Value2 = "Standard"
  
           End With
       Application.EnableEvents = True
       Application.ScreenUpdating = True
  
      End Sub
  Sub deleteIrrelevantColumns() 'delete all columns except for the ones with a certain name.
  
      Dim currentColumn As Integer
      Dim columnHeading As String
  
  Application.EnableEvents = False
  Application.ScreenUpdating = False
      'ActiveSheet.Columns("L").Delete
  
      For currentColumn = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
  
          columnHeading = ActiveSheet.UsedRange.Cells(1, currentColumn).Value
  
          'CHECK WHETHER TO KEEP THE COLUMN
          Select Case columnHeading
              Case "QC", "gene", "exon", "cDNA", "AAchange", "%Alt", "Standard"
                  'Do nothing
              Case Else
                  'Delete if the cell doesn't contain these
                  If InStr(1, _
                     ActiveSheet.UsedRange.Cells(1, currentColumn).Value, _
                     "Matreshkaper", vbBinaryCompare) = 0 Then
  
                      ActiveSheet.Columns(currentColumn).Delete
  
                  End If
          End Select
      Next
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  
  End Sub
  
  
  
  Sub PopulateStandard()
  'PURPOSE: Filter on specific values
  
  
  Dim rng As Range
  Dim LastRow, i As Long
  Dim GeneCheck As String
  Dim vArr As Variant
  Dim x
  Dim y
  
  'wsQC.Select
  Worksheets("QC").Select
  
  LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
  
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  
  
  vArr = Array(Array("HD300_QCL861Q", "5"), _
  Array("HD300_QCE746_E749del", "5"), _
  Array("HD300_QCL858R", "5"), _
  Array("HD300_QCT790M", "5"), _
  Array("HD300_QCG719S", "5"), _
  Array("HD200_QCV600E", "10.5"), _
  Array("HD200_QCD816V", "10"), _
  Array("HD200_QCE746_E749del", "2"), _
  Array("HD200_QCL858R", "3"), _
  Array("HD200_QCT790M", "1"), _
  Array("HD200_QCG719S", "24.5"), _
  Array("HD200_QCG13D", "15"), _
  Array("HD200_QCG12D", "6"), _
  Array("HD200_QCQ61K", "12.5"), _
  Array("HD200_QCH1047R", "17.5"), _
  Array("HD200_QCE545K", "9"))
  
  
  
  For i = 2 To LastRow
  
  GeneCheck = Right(Cells(i, 1).Value, 8) &amp; Cells(i, 5).Value
  
  '//Tell VBA to ignore an error and continue (ie if it can't find the value)
          On Error Resume Next
  
  '//Assign the result of your calculation to a variable that VBA can query
  
      x = WorksheetFunction.VLookup(GeneCheck, vArr, 2, False)
  
  
  
       '//if Vlookup finds the value, then paste it into the required column
          If Err = 0 Then
  
      Cells(i, 6).Value = x
              Else
  
              End If
  
              '//resets to normal error handling
              On Error GoTo 0
  Next
  
  
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  End Sub
  
  Sub MissingValues()
  
  Dim zArr As Variant
  Dim yArr As Variant
  
  Dim LastRow As Long
  Dim LastRow2 As Long
  Dim sht As Worksheet
  
  Set sht = ThisWorkbook.Worksheets("QC")
  
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  
  yArr = Array(Array("EGFR", "", "", "L861Q", "5"), _
         Array("EGFR", "", "", "KELRE745delinsK", "5"), _
         Array("EGFR", "", "", "L858R", "5"), _
         Array("EGFR", "", "", "T790M", "5"), _
         Array("EGFR", "", "", "G719S", "5"))
  
  zArr = Array(Array("BRAF", "", "", "V600E", "10.5"), _
          Array("KIT", "", "", "D816V", "10"), _
          Array("EGFR", "", "", "KELRE745delinsK", "2"), _
          Array("EGFR", "", "", "L858R", "3"), _
          Array("EGFR", "", "", "T790M", "1"), _
          Array("EGFR", "", "", "G719S", "24.5"), _
          Array("KRAS", "", "", "G13D", "15"), _
          Array("KRAS", "", "", "G12D", "6"), _
          Array("NRAS", "", "", "Q61K", "12.5"), _
          Array("PIK3CA", "", "", "H1047R", "17.5"), _
          Array("PIK3CA", "", "", "E545K", "9"))
  
  'Ctrl + Shift + End
  LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
  
  If InStr(1, ActiveSheet.Range("A2").Value, "HD200") &gt; 0 Then
  
  
      Sheets("QC").Select
          Worksheets("QC").Range("B" &amp; LastRow + 2 &amp; ":F" &amp; LastRow + 12).Value = Application.Index(zArr, 0)
  
  ElseIf InStr(1, ActiveSheet.Range("A2").Value, "HD300") &gt; 0 Then
  
  
      Sheets("QC").Select
          Worksheets("QC").Range("B" &amp; LastRow + 2 &amp; ":F" &amp; LastRow + 6).Value = Application.Index(yArr, 0)
  
  End If
  
  LastRow2 = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row
  
  'MsgBox (LastRow2)
  
  Columns("B:G").Select
      ActiveSheet.Range("$A$1:$G$" &amp; LastRow2).RemoveDuplicates Columns:=Array(2, 5, 6), _
          Header:=xlYes
      Range("A1").Select
  
  
  With Worksheets("QC")
          'lRow = .Range("A" &amp; Rows.Count).End(xlUp).Row
          .Cells(LastRow + 1, 1).Value = "Removed Low Alts."
  End With
  
      Columns("A:A").Select
      Range(Selection, Selection.End(xlToRight)).Select
      Columns("A:G").EntireColumn.AutoFit
      Range("A1").Select
  
  
      Range("A1").Select
      Range(Selection, Selection.End(xlDown)).Select
      Range(Selection, Selection.End(xlToRight)).Select
      ActiveWorkbook.Worksheets("QC").Sort.SortFields.clear
      ActiveWorkbook.Worksheets("QC").Sort.SortFields.Add Key:=Range("F2:F" &amp; LastRow), _
          SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
      With ActiveWorkbook.Worksheets("QC").Sort
          .SetRange Range("A1:G" &amp; LastRow)
          .Header = xlYes
          .MatchCase = False
          .Orientation = xlTopToBottom
          .SortMethod = xlPinYin
          .Apply
      End With
  
  
  
      ' Adds a grid around the data
  LastRow2 = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row
      Range("A2:G" &amp; LastRow2).Select
      Selection.Borders(xlDiagonalDown).LineStyle = xlNone
      Selection.Borders(xlDiagonalUp).LineStyle = xlNone
      With Selection.Borders(xlEdgeLeft)
          .LineStyle = xlContinuous
          .colorIndex = 0
          .TintAndShade = 0
          .Weight = xlThin
      End With
      With Selection.Borders(xlEdgeTop)
          .LineStyle = xlContinuous
          .colorIndex = 0
          .TintAndShade = 0
          .Weight = xlThin
      End With
      With Selection.Borders(xlEdgeBottom)
          .LineStyle = xlContinuous
          .colorIndex = 0
          .TintAndShade = 0
          .Weight = xlThin
      End With
      With Selection.Borders(xlEdgeRight)
          .LineStyle = xlContinuous
          .colorIndex = 0
          .TintAndShade = 0
          .Weight = xlThin
      End With
      With Selection.Borders(xlInsideVertical)
          .LineStyle = xlContinuous
          .colorIndex = 0
          .TintAndShade = 0
          .Weight = xlThin
      End With
      With Selection.Borders(xlInsideHorizontal)
          .LineStyle = xlContinuous
          .colorIndex = 0
          .TintAndShade = 0
          .Weight = xlThin
      End With
      '~~~~&gt; add yellow color
      Range("F2:G" &amp; LastRow2).Select
      With Selection.Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .Color = 12514808
          .TintAndShade = 0
          .PatternTintAndShade = 0
      End With
  
      '~~~~&gt; make font red
       Range("F2:F" &amp; LastRow2).Select
      With Selection.Font
          .Color = -16777024
          .TintAndShade = 0
      End With
  
  
      Range("A1").Select
  
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  
  End Sub
  
  
  Sub Filter()
  
  
  'PURPOSE: Filter on specific values
  
  
  Dim rng As Range
  Dim LastRow, i As Long
  Dim GeneCheck As String
  Dim vArr As Variant
  Dim x
  Dim y
  Dim FilterField As Variant
  'wsQC.Select
  Worksheets("QC").Select
  
  LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
  
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  
  Set rng = ActiveSheet.Range("A1:AC" &amp; LastRow)
  FilterField = WorksheetFunction.Match("AAchange", rng.Rows(1), 0)
  
  'Turn on filter if not already turned on
   'If ActiveSheet.AutoFilterMode = False Then rng.AutoFilter
  
        If InStr(1, ActiveSheet.Range("A2").Value, "HD200") &gt; 0 Then
       rng.AutoFilter
  'Filter Specific Countries
      rng.AutoFilter Field:=FilterField, Criteria1:=Array( _
      "V600E", "KELRE745delinsK", "T790M", "G719S", "D816V", "G13D", "G12D", "Q61K", "H1047R", "L858R", "E545K"), Operator:=xlFilterValues
  
       Else 'If InStr(1, ActiveSheet.Range("A2").Value, "HD300") &gt; 0 Then
  
       rng.AutoFilter
        rng.AutoFilter Field:=FilterField, Criteria1:=Array( _
        "L861Q", "KELRE745delinsK", "L858R", "T790M", "G719S"), Operator:=xlFilterValues
  
       End If
  
  'End If
  
   '~~~&gt; format top row.
   Range("A1").Select 'format top row
      Range(Selection, Selection.End(xlToRight)).Select
      With Selection.Interior
          .Pattern = xlPatternLinearGradient
          .Gradient.Degree = 90
          .Gradient.ColorStops.clear
      End With
      With Selection.Interior.Gradient.ColorStops.Add(0)
          .Color = 11298378
          .TintAndShade = 0
      End With
      With Selection.Interior.Gradient.ColorStops.Add(1)
          .Color = 5384228
          .TintAndShade = 0
      End With
      With Selection.Font
          .ThemeColor = xlThemeColorDark1
          .TintAndShade = 0
      End With
  
  
  
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  
  
  End Sub
  </code></pre>