Why is my spreadsheet increasing to maximum size automatically?

G

GAMAP

While working with Excel 2007, we have notice that intermitantly during row
insert and cut & paste function, the sheet auto-expands to maximum size
(column XFD and Row 105000000+). This causes the file size to be very large
and EXCEL starts giving warnings of "operation involving large amount of
data" during simple task. The only indication this has happened before a
save is the scroll bar shrinks down.

Has anyone seen this issue? Is there anything we can do to stop this from
happening?
 
T

Tim879

I got this macro from a MS site not too long ago and it resets the
last row used .


Public mnu As CommandBarButton

Sub ClearExcessRowsAndColumns()

'downloaded from Microsoft's website.
'clears excess rows and formatting
'resets last used row to be the true last row.

Dim ar As Range, r As Double, C As Double, tr As Double, tc As
Double
Dim wksWks As Worksheet, ur As Range, arCount As Integer, i As
Integer
Dim blProtCont As Boolean, blProtScen As Boolean, blProtDO As
Boolean
Dim shp As Shape

On Error Resume Next
For Each wksWks In ActiveWorkbook.Worksheets
Err.Clear
'Store worksheet protection settings and unprotect if protected.
blProtCont = wksWks.ProtectContents
blProtDO = wksWks.ProtectDrawingObjects
blProtScen = wksWks.ProtectScenarios
wksWks.Unprotect ""
If Err.Number = 1004 Then
Err.Clear
MsgBox "'" & wksWks.Name & _
"' is protected with a password and cannot be checked."
_
, vbInformation
Else
Application.StatusBar = "Checking " & wksWks.Name & ", Please
Wait..."
r = 0
C = 0

'Determine if the sheet contains both formulas and constants
Set ur =
Union(wksWks.UsedRange.SpecialCells(xlCellTypeConstants), _
wksWks.UsedRange.SpecialCells(xlCellTypeFormulas))
'If both fails, try constants only
If Err.Number = 1004 Then
Err.Clear
Set ur =
wksWks.UsedRange.SpecialCells(xlCellTypeConstants)
End If
'If constants fails then set it to formulas
If Err.Number = 1004 Then
Err.Clear
Set ur = wksWks.UsedRange.SpecialCells(xlCellTypeFormulas)
End If
'If there is still an error then the worksheet is empty
If Err.Number <> 0 Then
Err.Clear
If wksWks.UsedRange.Address <> "$A$1" Then
ur.EntireRow.Delete
Else
Set ur = Nothing
End If
End If
'On Error GoTo 0
If Not ur Is Nothing Then
arCount = ur.Areas.Count
'determine the last column and row that contains data or
formula
For Each ar In ur.Areas
i = i + 1
tr = ar.Range("A1").row + ar.Rows.Count - 1
tc = ar.Range("A1").Column + ar.Columns.Count - 1
If tc > C Then C = tc
If tr > r Then r = tr
Next
'Determine the area covered by shapes
'so we don't remove shading behind shapes
For Each shp In wksWks.Shapes
tr = shp.BottomRightCell.row
tc = shp.BottomRightCell.Column
If tc > C Then C = tc
If tr > r Then r = tr
Next
Application.StatusBar = "Clearing Excess Cells in " & _
wksWks.Name & ", Please Wait..."
Set ur = wksWks.Rows(r + 1 & ":" & wksWks.Rows.Count)
ur.Clear
'Reset row height which can also cause the lastcell to be
innacurate
ur.EntireRow.RowHeight = _
wksWks.StandardHeight
Set ur = wksWks.Range(wksWks.Cells(1, C + 1), _
wksWks.Cells(1, 256)).EntireColumn
'Reset column width which can also cause the lastcell to
be innacurate
ur.EntireColumn.ColumnWidth = _
wksWks.StandardWidth
End If
End If
'Reset protection.
wksWks.Protect "", blProtDO, blProtCont, blProtScen
Err.Clear

ActiveCell.SpecialCells(xlLastCell).Select
Next
Application.StatusBar = False

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top