Can not remove empty cells

[Roncondor]

I have a spreadsheet with many tabs that suddenly tripled in size.

On most tabs, when I hit CTRL-SHIFT-END it takes me exactly to FZ500 - regardless of the # of rows and columns that I am using.

I try deleting all of the extra columns to the right and all of the extra rows on the bottom, but it is still the same size and still takes me to FZ500

is there something unique about FZ500?

I really need to shrink the spreadsheet. Any suggestions?

I will donate $25 to the non-denominational charity of choice to the person who provides the first/best answer!

 

[cerfani]

What specifically are you trying to delete? Describe it. Blank rows and columns? You can check this out... https://www.thespreadsheetguru.com/blog/2015/3/8/remove-blank-rows-columns-with-this-vba-macro

The FZ500 thing sounds like a bug or because formatting or data was once applied to a larger range and after clearing those cells they are still included in the used range.

 

[Roncondor]

What specifically are you trying to delete? Describe it. Blank rows and columns? You can check this out... https://www.thespreadsheetguru.com/blog/2015/3/8/remove-blank-rows-columns-with-this-vba-macro

The FZ500 thing sounds like a bug or because formatting or data was once applied to a larger range and after clearing those cells they are still included in the used range.

Thank you - that worked perfectly. What would even more helpful if the macro did it for every tab so don't have to do each one individually. What is your charity?

 

[cerfani]

I modified the code to loop every sheet in a workbook that you need to provide the name for:

Sub RemoveBlankRowsColumns()

Dim sheet As Worksheet 'ADDED BY CERFANI
For Each sheet In Workbooks("Put a file name here.xlsx") 'ADDED BY CERFANI
'PURPOSE: Remove blank rows or columns contained in the spreadsheets UsedRange
'SOURCE: www.TheSpreadsheetGuru.com




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 = sheet.UsedRange 'ADDED BY CERFANI
  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 & columns " & _
    "outside of your data?" & vbNewLine & vbNewLine & "Current Used Range is " & 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 & Accumulate Rows to Delete
  For x = RowCount To 1 Step -1
    'Is Row Not Empty?
      If Application.WorksheetFunction.CountA(rng.Rows(x)) <> 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 & Accumulate Columns to Delete
  For x = ColCount To 1 Step -1
    'Is Column Not Empty?
      If Application.WorksheetFunction.CountA(rng.Columns(x)) <> 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 > 0 Then
    sheet.UsedRange 'ADDED BY CERFANI
  Else
    MsgBox "No blank rows or columns were found!", vbInformation, "No Blanks Found On " & sheet.Name  'ADDED BY CERFANI
  End If
Next sheet 'ADDED BY CERFANI
ExitMacro:
  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True
  rng.Cells(1, 1).Select
  
End Sub

it is untested so i have no idea if I updated everything correctly, i only quickly glanced the code... you need to put the name of the workbook into the code and make sure that workbook is open when you run the code.

I don't know much about charities but I googled children's cancer charities and this one looks legit... https://childrenscancer.org/

They could probably put the money to good use. If you know a better charity though, let me know. Anything that has to do with children's cancer or children burn victims I would donate too.

 

[cerfani]

made a last second update to code

 

[Roncondor]

I modified the code to loop every sheet in a workbook that you need to provide the name for:

Sub RemoveBlankRowsColumns()

it is untested so i have no idea if I updated everything correctly, i only quickly glanced the code... you need to put the name of the workbook into the code and make sure that workbook is open when you run the code.

I don't know much about charities but I googled children's cancer charities and this one looks legit... https://childrenscancer.org/

They could probably put the money to good use. If you know a better charity though, let me know. Anything that has to do with children's cancer or children burn victims I would donate too.

I will send to https://www.cityofhope.org/homepage thanks

 

[cerfani]

That sounds good... turned an excel headache into a good deed

Thanks for the offer!