Decompile Excel VBA code

  • Thread starter Thread starter Stan
  • Start date Start date
S

Stan

Hello all,

I have been working in a large workbook 70+ worksheets. I was writing
code to duplicate a form(worksheet) and failed to set some objects to
nothing as I was testing the code. As a result the file bloated up to
17 MB from 4 MB.

There is a little known capability in MS Access to decompile a
database.
Create a shortcut and use the decompile switch:
"C:\Program Files\Microsoft Office\Office10\MSACCESS.EXE"
"D:\database.mdb" /decompile

Is there something similar in Excel or does anyone have any suggestion
to get the file back to it's original size?
 
You can try this code. It Deletes all of the cells below and to the right of
the last populated cells. It may do the trick... Make a copy first before you
try running this code. You need to change "???" to the sheet password to
unprotect the sheets (assuming they are protected).

Public Sub CompactAllSheets()
Dim wks As Worksheet
Dim blnIsProtected As Boolean
Dim wbk As Workbook

Set wbk = ActiveWorkbook
For Each wks In Worksheets
If wks.ProtectContents = True Then
blnIsProtected = True
wks.Unprotect "???"
Else
blnIsProtected = False
End If
Call CompactSheet(wks)
If blnIsProtected = True Then wks.Protect "???"
Next wks

If MsgBox("For the compact to complete the spreadsheet must be saved. "
& _
"Do you want to save now?", vbYesNo + vbInformation, "Save?") = vbYes
Then wbk.Save
End Sub


Public Sub CompactSheet(Optional ByVal wks As Worksheet)
Dim rng As Range

If wks Is Nothing Then Set wks = ActiveSheet
Set rng = LastCell(wks)
wks.Range(rng.Offset(0, 1), wks.Cells(1,
Columns.Count)).EntireColumn.Delete
wks.Range(rng.Offset(1, 0), wks.Cells(Rows.Count, 1)).EntireRow.Delete

End Sub


Public Function LastCell(Optional ByVal wks As Worksheet) As Range
Dim lngLastRow As Long
Dim intLastColumn As Integer

If wks Is Nothing Then Set wks = ActiveSheet
On Error Resume Next
lngLastRow = wks.Cells.Find(What:="*", _
After:=wks.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
intLastColumn = wks.Cells.Find(What:="*", _
After:=wks.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
If lngLastRow = 0 Then
lngLastRow = 1
intLastColumn = 1
End If
Set LastCell = wks.Cells(lngLastRow, intLastColumn)

End Function
 
Thanks for the code Jim. I tested it, but it's too risky to run on the
workbook. To many empty cells at the bottom of ranges that may
populate at a later time.

Thanks again!
 
Believe it or not Tom it was the code. The code cleaner took it back
to the original size.

Thanks for the help,
Stan
 
Back
Top