Worksheets in VBA

Introduction

Excel has the ability to manage it's worksheet as part of a collection. The parent to that collection is the workbook.

This page describes some VBA procedure that you can use to operate on multiple worksheet in a workbook. These functions assume different values for password or that they are visible

Hide all sheet, assuming there is no protection on them

Sub hideallsheet()

Dim mysheet As Worksheet

For Each mysheet In ThisWorkbook.Worksheets

mysheet.Visible = xlSheetHidden

Next

End Sub

Unprotect all sheets, assuming they have no password. If a password exists, an argument needs to be added to the unprotect part of the code

Sub unprotectall()

Dim myboolean As Boolean

Dim mysheet As Worksheet

myboolean = Application.ScreenUpdating

Application.ScreenUpdating = False

For Each mysheet In Worksheets

unprotect mysheet

Next

Application.ScreenUpdating = myboolean

End Sub

Unprotect a specific sheet, with optional password

Sub unprotect(mysheet As Worksheet, Optional mypassword As String)

On Error Resume Next

mysheet.unprotect mypassword

On Error GoTo 0

End Sub

Protect a specific heet, with optional password

Sub protectallsheet()

Dim mysheet As Worksheet

For Each mysheet In Worksheets

Protectsheet mysheet

Next

End Sub

Protect one specific sheet, with a password that is optional

Sub Protectsheet(mysheet As Worksheet, Optional mypassword As String)

With mysheet

.Protect "prsq", DrawingObjects:=True, Contents:=True, Scenarios:=True _

, AllowFiltering:=True, AllowUsingPivotTables:=True

End With

End Sub

'Needed to reduce the file size. Modified slightly from the microsoft version to unprotect all sheets

Sub ClearExcessRowsAndColumns()

Dim ar As Range, r As Double, c As Double, tr As Double, tc As Double

Dim wksWks As Worksheet, ur As Range, i As Integer

Dim blProtCont As Boolean, blProtScen As Boolean, blProtDO As Boolean

Dim shp As Shape

Application.EnableEvents = False

Application.Calculation = xlCalculationManual

unProtectAllSheets

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

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

'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

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

Next

ActiveWorkbook.Save

Application.EnableEvents = True

Application.Calculation = xlCalculationAutomatic

End Sub