Enable the Developer Tab.
Select File > Options.

001.jpg
002.jpg

Select Customize Ribbon. Enable the Developer Tab.

003.jpg

Click on Visual Basic to open the VBA Editor.

004.jpg

Insert a Module.

005.jpg

Copy the codes in the white area.

006.jpg

To run the code, select Developer > Macros.

007.jpg

Select the Macro from the list and click on Run.

008.jpg

Copy and Paste these codes:

Add New Sheet

Sub HMC_AddANewSheet()

     

Sheets.Add

End Sub 

Unhide All Sheets

Sub HMC_UnhideAllSheets()

Dim wks As Worksheet

 

For Each wks In ActiveWorkbook.Worksheets

wks.Visible = xlSheetVisible

Next wks

End Sub

Create Table of Content

Sub HMC_CreateTableofContent()


'PURPOSE: Add a Table of Contents worksheets to easily navigate to any tab
'SOURCE: www.TheSpreadsheetGuru.com

Dim sht As Worksheet
Dim Content_sht As Worksheet
Dim myArray As Variant
Dim x As Long, y As Long
Dim shtName1 As String, shtName2 As String
Dim ContentName As String

'Inputs
ContentName = "Contents"

'Optimize Code
Application.DisplayAlerts = False
Application.ScreenUpdating = False

'Delete Contents Sheet if it already exists
On Error Resume Next
Worksheets("Contents").Activate
On Error GoTo 0

If ActiveSheet.Name = ContentName Then
myAnswer = MsgBox("A worksheet named [" & ContentName & _
"] has already been created, would you like to replace it?", vbYesNo)
    
'Did user select No or Cancel?
If myAnswer <> vbYes Then GoTo ExitSub
      
'Delete old Contents Tab
Worksheets(ContentName).Delete
End If

'Create New Contents Sheet
  Worksheets.Add Before:=Worksheets(1)

'Set variable to Contents Sheet
Set Content_sht = ActiveSheet

'Format Contents Sheet
With Content_sht
.Name = ContentName
.Range("B1") = "Table of Contents"
.Range("B1").Font.Bold = True
End With

'Create Array list with sheet names (excluding Contents)
ReDim myArray(1 To Worksheets.Count - 1)

For Each sht In ActiveWorkbook.Worksheets
If sht.Name <> ContentName Then
myArray(x + 1) = sht.Name
x = x + 1
End If
Next sht
  
'Alphabetize Sheet Names in Array List
For x = LBound(myArray) To UBound(myArray)
For y = x To UBound(myArray)
If UCase(myArray(y)) < UCase(myArray(x)) Then
shtName1 = myArray(x)
shtName2 = myArray(y)
myArray(x) = shtName2
myArray(y) = shtName1
End If
Next y
Next x

'Create Table of Contents
 For x = LBound(myArray) To UBound(myArray)
 Set sht = Worksheets(myArray(x))
 sht.Activate
 With Content_sht
 .Hyperlinks.Add .Cells(x + 2, 3), "", _
 SubAddress:="'" & sht.Name & "'!A1", _
 TextToDisplay:=sht.Name
 .Cells(x + 2, 2).Value = x
 End With
 Next x
  
Content_sht.Activate
Content_sht.Columns(3).EntireColumn.AutoFit

'A Splash of Guru Formatting! [Optional]
 Columns("A:B").ColumnWidth = 3.86
 Range("B1").Font.Size = 18
 Range("B1:F1").Borders(xlEdgeBottom).Weight = xlThin
  
 With Range("B3:B" & x + 1)
 .Borders(xlInsideHorizontal).Color = RGB(255, 255, 255)
 .Borders(xlInsideHorizontal).Weight = xlMedium
 .HorizontalAlignment = xlCenter
 .VerticalAlignment = xlCenter
 .Font.Color = RGB(255, 255, 255)
 .Interior.Color = RGB(91, 155, 213)
 End With

'Adjust Zoom and Remove Gridlines
ActiveWindow.DisplayGridlines = False
ActiveWindow.Zoom = 130

ExitSub:
'Optimize Code
Application.DisplayAlerts = True
Application.ScreenUpdating = True
  
End Sub

Delete Blank Rows

Sub HMC_DeleteBlankRows()

Dim SourceRange As Range

Dim EntireRow As Range

 

Set SourceRange = Application.Selection

 

If Not (SourceRange Is Nothing) Then

Application.ScreenUpdating = False

 

For I = SourceRange.Rows.Count To 1 Step -1

Set EntireRow = SourceRange.Cells(I, 1).EntireRow

If Application.WorksheetFunction.CountA(EntireRow) = 0 Then

EntireRow.Delete

End If

Next

 

Application.ScreenUpdating = True

End If

End Sub

Highlight Top 10 Values

Sub HMC_Top10Values()
 

Selection.FormatConditions.AddTop10 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

With Selection.FormatConditions(1)

.TopBottom = xlTop10Top

'Change the rank here to highlight a different number of values

.Rank = 10

.Percent = False

End With

With Selection.FormatConditions(1).Font

.Color = -16752384

.TintAndShade = 0

End With

 

With Selection.FormatConditions(1).Interior

.PatternColorIndex = xlAutomatic

.Color = 13561798

.TintAndShade = 0

End With

Selection.FormatConditions(1).StopIfTrue = False
 

End Sub

Protect All Sheets

Sub HMC_ProtectAllSheets()

 

'Declare your variables

Dim ws As Worksheet

 

'Start looping through all worksheets

For Each ws In ActiveWorkbook.Worksheets

 

'Protect and loop to next worksheet

ws.Protect Password:="1234"

Next ws

 

End Sub

  • LinkedIn
  • YouTube
  • Instagram

©2020 by HAVISH M. CONSULTING. Proudly created with Wix.com