title: Remove Blank (Empty) Columns Excel VBA
body: <p>I humbly ask for help modifying this code.  I have created an access database which is the information repository for approximately 30 versions of an excel spreadsheet to use for retrieving the most up-to-date information for the workbook.  After the workbook has updated the information in the helper sheets, and the user enters the appropriate fields, there are MANY unused columns and rows that need to be removed.  Each of the helper sheets dynamically pull data using formulas; therefore, the cells are not truly Empty.  I found this code which works amazingly well for removing empty cells, but I cannot figure out how to modify it so that it removes the columns which store formulas that are not being used.</p>
  
  <pre><code>Sub RemoveBlankRowsColumns()
      Dim rng As Range
      Dim rngDelete As Range
      Dim RowCount As Long, ColCount As Long
      Dim EmptyTest As Boolean, StopAtData As Boolean
      Dim RowDeleteCount As Long, ColDeleteCount As Long
      Dim x As Long
      Dim UserAnswer As Variant
  
  'Analyze the UsedRange
      Set rng = ActiveSheet.UsedRange
      rng.Select
  
      RowCount = rng.Rows.Count
      ColCount = rng.Columns.Count
      DeleteCount = 0
  
  'Determine which cells to delete
      UserAnswer = MsgBox("Do you want to delete only the empty rows &amp; columns " &amp; _
      "outside of your data?" &amp; vbNewLine &amp; vbNewLine &amp; "Current Used Range is " &amp; rng.Address, vbYesNoCancel)
  
      If UserAnswer = vbCancel Then
          Exit Sub
      ElseIf UserAnswer = vbYes Then
          StopAtData = True
      End If
  
  'Optimize Code
      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual
      Application.EnableEvents = False
  
  'Loop Through Rows &amp; Accumulate Rows to Delete
      For x = RowCount To 1 Step -1
  'Is Row Not Empty?
          If Application.WorksheetFunction.CountBlank(rng.Rows(x)) &lt;&gt; 0 Then
              If StopAtData = True Then Exit For
          Else
              If rngDelete Is Nothing Then Set rngDelete = rng.Rows(x)
              Set rngDelete = Union(rngDelete, rng.Rows(x))
              RowDeleteCount = RowDeleteCount + 1
          End If
      Next x
  
  'Delete Rows (if necessary)
      If Not rngDelete Is Nothing Then
          rngDelete.EntireRow.Delete Shift:=xlUp
          Set rngDelete = Nothing
      End If
  
  'Loop Through Columns &amp; Accumulate Columns to Delete
      For x = ColCount To 1 Step -1
  'Is Column Not Empty?
          If Application.WorksheetFunction.CountBlank(rng.Columns(x)) &lt;&gt; 0 Then
              If StopAtData = True Then Exit For
          Else
              If rngDelete Is Nothing Then Set rngDelete = rng.Columns(x)
              Set rngDelete = Union(rngDelete, rng.Columns(x))
              ColDeleteCount = ColDeleteCount + 1
          End If
      Next x
  
  'Delete Columns (if necessary)
      If Not rngDelete Is Nothing Then
          rngDelete.Select
          rngDelete.EntireColumn.Delete
      End If
  
  'Refresh UsedRange (if necessary)
      If RowDeleteCount + ColDeleteCount &gt; 0 Then
          ActiveSheet.UsedRange
      Else
          MsgBox "No blank rows or columns were found!", vbInformation, "No Blanks Found"
      End If
  
  ExitMacro:
      Application.Calculation = xlCalculationAutomatic
      Application.EnableEvents = True
      Application.ScreenUpdating = True
      rng.Cells(1, 1).Select
  End Sub
  </code></pre>
  
  <h3>Screenshot of spreadsheet</h3>
  
  <p><img src="https://i.stack.imgur.com/R0TaE.png" alt="Screenshot of spreadsheet"></p>
  
  <p>In the Screenshot of spreadsheet, cells A1-T221 are active and are being used in the workbook; however, </p>
  
  <ul>
  <li>Rows 222:5000 have formulas that are not being used in this workbook.</li>
  <li>Columns T1:EP5000 have formulas that are not being used in this workbook.</li>
  </ul>
  
  <p>Again- Thank you in advance for your help with finding a solution to this modification need.</p>