DaveRadford
Board Regular
- Joined
- Feb 18, 2010
- Messages
- 63
Afternoon,
I have a sub in a macro that will shrink the size of my excel workbook as when used the temp data of having cells full of data and then not causes the spreadsheet to grow large.
The code is:
Sub DeleteUnused()
Dim myLastRow As Long
Dim myLastCol As Long
Dim wks As Worksheet
Dim dummyRng As Range
For Each wks In ActiveWorkbook.Worksheets
With wks
myLastRow = 0
myLastCol = 0
Set dummyRng = .UsedRange
On Error Resume Next
myLastRow = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByRows).Row
myLastCol = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByColumns).Column
On Error GoTo 0
If myLastRow * myLastCol = 0 Then
.Columns.Delete
Else
.Range(.Cells(myLastRow + 1, 1), _
.Cells(.Rows.Count, 1)).EntireRow.Delete
.Range(.Cells(1, myLastCol + 1), _
.Cells(1, .Columns.Count)).EntireColumn.Delete
End If
End With
Next wks
End Sub
Now i have a couple issues:
If i put the code anywehre else apart from at the end it fails with error to do with:
Else
.Range(.Cells(myLastRow + 1, 1), _
.Cells(.Rows.Count, 1)).EntireRow.Delete
.Range(.Cells(1, myLastCol + 1), _
.Cells(1, .Columns.Count)).EntireColumn.Delete
If i have it at the end it also prompts "Do you want to save the changes" I dont want this to appear as i have a save& exit button itdefeats the point.
Full Save&Exit Code:
Sub SaveandExit_Click()
Dim Answer As String
Dim MyNote As String
MyNote = "Save Changes & Exit?"
Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Save Changes & Exit")
If Answer = vbNo Then
Application.DisplayFullScreen = True
End If
If Answer = vbYes Then
ThisWorkbook.Save
Application.Quit
Application.DisplayFullScreen = False
DeleteUnused
End If
End Sub
Thanks,
I have a sub in a macro that will shrink the size of my excel workbook as when used the temp data of having cells full of data and then not causes the spreadsheet to grow large.
The code is:
Sub DeleteUnused()
Dim myLastRow As Long
Dim myLastCol As Long
Dim wks As Worksheet
Dim dummyRng As Range
For Each wks In ActiveWorkbook.Worksheets
With wks
myLastRow = 0
myLastCol = 0
Set dummyRng = .UsedRange
On Error Resume Next
myLastRow = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByRows).Row
myLastCol = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByColumns).Column
On Error GoTo 0
If myLastRow * myLastCol = 0 Then
.Columns.Delete
Else
.Range(.Cells(myLastRow + 1, 1), _
.Cells(.Rows.Count, 1)).EntireRow.Delete
.Range(.Cells(1, myLastCol + 1), _
.Cells(1, .Columns.Count)).EntireColumn.Delete
End If
End With
Next wks
End Sub
Now i have a couple issues:
If i put the code anywehre else apart from at the end it fails with error to do with:
Else
.Range(.Cells(myLastRow + 1, 1), _
.Cells(.Rows.Count, 1)).EntireRow.Delete
.Range(.Cells(1, myLastCol + 1), _
.Cells(1, .Columns.Count)).EntireColumn.Delete
If i have it at the end it also prompts "Do you want to save the changes" I dont want this to appear as i have a save& exit button itdefeats the point.
Full Save&Exit Code:
Sub SaveandExit_Click()
Dim Answer As String
Dim MyNote As String
MyNote = "Save Changes & Exit?"
Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Save Changes & Exit")
If Answer = vbNo Then
Application.DisplayFullScreen = True
End If
If Answer = vbYes Then
ThisWorkbook.Save
Application.Quit
Application.DisplayFullScreen = False
DeleteUnused
End If
End Sub
Thanks,