Remove unused rows/columns at end of spreadsheet (Excel 2019)

[RincewindWIZZ]

In the good old days, Excel treated the work sheet as containing a limited number of cells bounded by the last cell you had manipulated (value, format etc). Then the scroll bar didn't go beyond this area (though you could move there with the cursor)
I have an spreadsheet (with 2000 active rows) showing the full 1M rows which makes the scroll bar useless
I've tried deleting the surplus rows; clearing the contents; clearing the formatting etc but I still get the full l 1M rows.
I even tried hiding them but then the vertical scroll bar fills (Goes from top to bottom) the entire worksheet so it is still useless

If I copy and paste the data into a new sheet, the scroll bars refer only to the pasted data but there are formulas that refer to specific worksheets and also some VBA code so I'd really prefer not to have to go down that route.

ANy suggestions on how I can make the current sheet ignore unused parts?

 

[Alex Blakenburg]

Take a back up of your workbook and run the below on the problem sheet.

Sub ResetLastCell()

Dim lLastRow As Long, lLastColumn As Long
Dim lRealLastRow As Long, lRealLastColumn As Long

' Find last row,column based on special cells method
With Range("A1").SpecialCells(xlCellTypeLastCell)
    lLastRow = .Row
    lLastColumn = .Column
End With

' Find backwards from A1 the last non-blank row
lRealLastRow = Cells.Find("*", Range("A1"), xlFormulas, , _
    xlByRows, xlPrevious).Row

' Find backwards from A1 the last non-blank column
lRealLastColumn = Cells.Find("*", Range("A1"), xlFormulas, , _
    xlByColumns, xlPrevious).Column
    
'Delete from the row after the real last row to the last row
'per special cells method
If lRealLastRow < lLastRow Then
    Range(Cells(lRealLastRow + 1, 1), Cells(lLastRow, 1)).EntireRow.Delete
End If

'Delete from the column after the real last column to
'the last column per special cells method
If lRealLastColumn < lLastColumn Then
    Range(Cells(1, lRealLastColumn + 1), Cells(1, lLastColumn)).EntireColumn.Delete
End If

' Reset Rows Heights
Rows(lRealLastRow + 1).Resize(Rows.Count - lRealLastRow).UseStandardHeight = True

ActiveSheet.UsedRange  'Resets last cell
    
End Sub

 

[RincewindWIZZ]

Sub ResetLastCell() Dim lLastRow As Long, lLastColumn As Long Dim lRealLastRow As Long, lRealLastColumn As Long ' Find last row,column based on special cells method With Range("A1").SpecialCells(xlCellTypeLastCell) lLastRow = .Row lLastColumn = .Column End With ' Find backwards from A1 the last non-blank row lRealLastRow = Cells.Find("*", Range("A1"), xlFormulas, , _ xlByRows, xlPrevious).Row ' Find backwards from A1 the last non-blank column lRealLastColumn = Cells.Find("*", Range("A1"), xlFormulas, , _ xlByColumns, xlPrevious).Column 'Delete from the row after the real last row to the last row 'per special cells method If lRealLastRow < lLastRow Then Range(Cells(lRealLastRow + 1, 1), Cells(lLastRow, 1)).EntireRow.Delete End If 'Delete from the column after the real last column to 'the last column per special cells method If lRealLastColumn < lLastColumn Then Range(Cells(1, lRealLastColumn + 1), Cells(1, lLastColumn)).EntireColumn.Delete End If ' Reset Rows Heights Rows(lRealLastRow + 1).Resize(Rows.Count - lRealLastRow).UseStandardHeight = True ActiveSheet.UsedRange 'Resets last cell End Sub

Thanks for this and apologies for the late response
It certainly reduced the size of the workbook (22MB -> 400k) but had some unpleasant side effects
It trashed all references to the initial sheet (so Import!$A$1 became #REF (including in the defined names)
It also bizarrely changed dotted lines in graphs to solid lines but left all other properties unchanged!!
Sadly I failed to notice (becaue only some of the sheets have references to the initial sheet) saved and continued. Also strangely it allowed me to save with these errors and only when I reopened the sheet did the errors appear and then it refused to allow a save (errors in formulas or names)
Attempts to recreate this more carefully have so far failed - but then subsequent attempts have not reset the last cell.
I will try again later in the week when I have a bit more time and report back
Thanks for yoru efforts

 

[Alex Blakenburg]

You indicated that you had deleted the rows manually below your used range and it didn't work.
Did you hit the save button and retest it ? (you need to hit Save or run a command using UsedRange in VBA to reset the spreadsheet.

Do you know how to use the immediate window (ctrl+G) if you can't see it in the VBA editor ?
Once you have deleted the rows, go to what you consider to be the last row of your data.
(just a cell in column A will do)
Ctrl+Shift+DownArrow
Paste the below into your immediate window and hit enter.

  Selection.EntireRow.UseStandardHeight = True : ActiveSheet.UsedRange

Or run it as a Sub (after selecting the rows)

Sub reset_rowheigths()
  Selection.EntireRow.UseStandardHeight = True
  ActiveSheet.UsedRange
End Sub

 

[RincewindWIZZ]

OK the first result was so bizarre and I could not reproduce it so I started again from the 22MB workbook
Selected the first sheet (Import) and ran your initial routine. Took maybe 15 secs and at the end the bottom row (End->Down) was sensible
selected second sheet. Ran macro, End->Down takes me to row 1M+
Saved workbook. Reloaded workbook
First sheet row 1M+; Seond sheet row 1M+

Went to first sheet
Selected col A in row below last used
VBA Immediate window and paste your line of code
end->Down goes to Row 1M+
Spreadsheet has come down from 22Mg to 3MB but I suspect that was entirely down to the first run of your routine

 

[Alex Blakenburg]

Do you have any event macros running ?

 

[johnnyL]

OK the first result was so bizarre and I could not reproduce it so I started again from the 22MB workbook
Selected the first sheet (Import) and ran your initial routine.

As soon as the code finishes, Do Nothing Other than immediately save the workbook, close it , reopen it & then test what the last row is.

Rinse & repeat for any other sheets you want to correct.

 

[RincewindWIZZ]

Do you have any event macros running ?

No.

 

[Alex Blakenburg]

Assuming you have run the macro on both sheets and the end of sheet is still too far down, it might be worth trying to change the rowheight before changing it back again.
So again from the visual end of the data, ctrl+shift+downarrow and run the code below.

If that doesn't work is there any way you can copy the problem sheets into a new workbook.
Delete all the data and just fill 1 column to where the data ends then share the workbook via a link to Dropbox, google drive etc so we can take a look.

Sub reset_rowheight()
  Selection.RowHeight = 20
  Selection.EntireRow.UseStandardHeight = True
  ActiveSheet.UsedRange
End Sub

 

[RincewindWIZZ]

Assuming you have run the macro on both sheets and the end of sheet is still too far down, it might be worth trying to change the rowheight before changing it back again.
So again from the visual end of the data, ctrl+shift+downarrow and run the code below.

If that doesn't work is there any way you can copy the problem sheets into a new workbook.
Delete all the data and just fill 1 column to where the data ends then share the workbook via a link to Dropbox, google drive etc so we can take a look.

Sub reset_rowheight()
  Selection.RowHeight = 20
  Selection.EntireRow.UseStandardHeight = True
  ActiveSheet.UsedRange
End Sub

So I tried all the various things than have been recommended, hacked all the data out of the spreadsheet except for one column Col H to row 1157); ran the code above (AGAIN!, just in case - still row 1M+) and saved it to dropbox at Junk2.xlsm
Comments most welcome Its a 2MB spreadhset for 1000 cells of data!!!