Option Explicit
Public wsSheet As Worksheet
Public iReply As Integer
Public rLastRow As Range
Public rlastCol As Range
Public bCalc As Boolean
Public strCleanType As String
Public bSaveCopy As Boolean
Public OldSize As String, NewSize As String
Dim strName As String
Dim fs, f, s
Sub CleanUpFull()
On Error Resume Next
Application.EnableEvents = False
If bSaveCopy = True Then Run "SaveCopyAs"
bCalc = Application.Calculation = _
xlCalculationAutomatic
If bCalc = True Then Application.Calculation = _
xlCalculationManual
For Each wsSheet In ActiveWorkbook.Worksheets
wsSheet.ShowAllData
With wsSheet.Cells
.SpecialCells(xlCellTypeBlanks).Clear
Set rLastRow = .Find(What:="*", After:=.Cells(1, 1), LookIn:=xlFormulas, _
searchOrder:=xlByRows, SearchDirection:=xlPrevious).Offset(1, 1)
Set rlastCol = .Find(What:="*", After:=.Cells(1, 1), LookIn:=xlFormulas, _
searchOrder:=xlByColumns, SearchDirection:=xlPrevious).Offset(1, 1)
End With
wsSheet.Range(rLastRow.EntireRow, _
rLastRow.EntireRow.End(xlDown)).Clear
wsSheet.Range(rlastCol.EntireColumn, _
rlastCol.EntireColumn.End(xlToRight)).Clear
Application.CutCopyMode = False
ActiveSheet.UsedRange
Next wsSheet
Application.EnableEvents = True
If bCalc = True Then Application.Calculation = xlCalculationAutomatic
If bSaveCopy = True Then
ActiveWorkbook.Save
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.Getfile(ActiveWorkbook.FullName)
NewSize = UCase(f.Name) & " uses " & f.Size & " bytes."
MsgBox "Procedure has finished." & Chr(13) & Chr(13) & OldSize & Chr(13) & Chr(13) & NewSize & Chr(13) & Chr(13) & "If the file size has increased, your Workbook is most likely corrupt. Restart the 'File Clean' and click the 'In case of corruption click here' button.", vbInformation, "OzGrid.com"
Run "KillVar"
Exit Sub
End If
Run "KillVar"
MsgBox "Procedure has finished, you will need to " _
& "save and then note if the file size has reduced via File>Properties / General" _
& Chr(13) & Chr(13) & "If the file size has increased, your Workbook is most likely corrupt. Restart the 'File Clean' and click the 'In case of corruption click here' button.", vbInformation, "OzGrid.com"
End Sub
Sub CleanUpStand()
On Error Resume Next
Application.EnableEvents = False
If bSaveCopy = True Then Run "SaveCopyAs"
bCalc = Application.Calculation = _
xlCalculationAutomatic
If bCalc = True Then Application.Calculation = _
xlCalculationManual
For Each wsSheet In ActiveWorkbook.Worksheets
With wsSheet.Cells
Set rLastRow = .Find(What:="*", After:=.Cells(1, 1), LookIn:=xlFormulas, _
searchOrder:=xlByRows, SearchDirection:=xlPrevious).Offset(1, 1)
Set rlastCol = .Find(What:="*", After:=.Cells(1, 1), LookIn:=xlFormulas, _
searchOrder:=xlByColumns, SearchDirection:=xlPrevious).Offset(1, 1)
End With
wsSheet.Range(rLastRow.EntireRow, _
rLastRow.EntireRow.End(xlDown)).Clear
wsSheet.Range(rlastCol.EntireColumn, _
rlastCol.EntireColumn.End(xlToRight)).Clear
Application.CutCopyMode = False
ActiveSheet.UsedRange
Next wsSheet
Application.EnableEvents = True
If bCalc = True Then Application.Calculation = xlCalculationAutomatic
If bSaveCopy = True Then
ActiveWorkbook.Save
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.Getfile(ActiveWorkbook.FullName)
NewSize = UCase(f.Name) & " uses " & f.Size & " bytes."
MsgBox "Procedure has finished." & Chr(13) & Chr(13) & OldSize & Chr(13) & Chr(13) & NewSize & Chr(13) & Chr(13) & "If the file size has increased, your Workbook is most likely corrupt. Restart the 'File Clean' and click the 'In case of corruption click here' button.", vbInformation, "OzGrid.com"
Run "KillVar"
Exit Sub
End If
Run "KillVar"
MsgBox "Procedure has finished, you will need to " _
& "save and then note if the file size has reduced via File>Properties / General" & Chr(13) & Chr(13) & "If the file size has increased, your Workbook is most likely corrupt. Restart the 'File Clean' and click the 'In case of corruption click here' button.", vbInformation, "OzGrid.com"
End Sub
Sub SaveCopyAs()
On Error Resume Next
strName = "CopyOf" & ActiveWorkbook.Name
ActiveWorkbook.SaveAs strName
End Sub
Sub CleanFormShow()
On Error Resume Next
UserForm1.Show
End Sub
Sub KillVar()
On Error Resume Next
Set wsSheet = Nothing
iReply = 0
Set rLastRow = Nothing
Set rlastCol = Nothing
bCalc = False
strCleanType = ""
bSaveCopy = False
OldSize = ""
NewSize = ""
strName = ""
Set fs = Nothing
Set f = Nothing
Set s = Nothing
On Error GoTo 0
End Sub
