KISS Excel VBA
Keep It Super Simple with Excel VBA
Module_05_Sheets
Copy and paste the below into a module in VBA
Sub Sheet_Add()
'Add a Sheet to the active workbook
Sheets.Add
End Sub
'--------------------------------------------------------------------------
Sub Sheet_Add_named()
'Add a named Sheet to the active workbook
Sheets.Add.Name = "test"
'add named sheet before active sheet
'Sheets.Add(, ActiveSheet).Name = "test"
End Sub
'--------------------------------------------------------------------------
Sub Sheet_rename()
'Rename the active Sheet to the value of the active cell
ActiveSheet.Name = ActiveCell.Value
End Sub
'--------------------------------------------------------------------------
Sub Sheet_select()
'Selects Sheet1
Sheets("Sheet1").Select
End Sub
'--------------------------------------------------------------------------
Sub Sheet_delete()
'Delete Sheet called "TEMP" with no alerts
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("TEMP").Delete
Application.DisplayAlerts = True
End Sub
'--------------------------------------------------------------------------
Sub Sheet_color_blue()
'Blue Sheet
'ActiveWorkbook.ActiveSheet.Tab.ColorIndex = xlAutomatic
With ActiveWorkbook.ActiveSheet.Tab
.Color = 12611584 'blue
' .Color = 255 'red
' .Color = 5287936 'green
' .Color = 65535 'yellow
' .Color = 10498160 'purple
End With
End Sub
'--------------------------------------------------------------------------
Sub Sheet_color_red()
'Red Sheet
ActiveSheet.Tab.ColorIndex = 3 'xlColorIndexNone
'3=Red , 4=green,5=blue,6=yellow,etc...
End Sub
'--------------------------------------------------------------------------
Sub Sheet_RemoveTabColor()
'Remove tab color from worksheet
'Specific Tab
'ThisWorkbook.Worksheets("Sheet1").Tab.ColorIndex = xlColorIndexNone
'Active Tab
ActiveSheet.Tab.ColorIndex = xlColorIndexNone
End Sub
'--------------------------------------------------------------------------
Sub Sheet_Count_Sheets()
'Counts how may sheets exist in the active workbook
MsgBox ActiveWorkbook.Sheets.Count
End Sub
'--------------------------------------------------------------------------
Sub Add_40_sheets()
For i = 1 To 40
Sheets.Add
Next i
End Sub
'--------------------------------------------------------------------------
Sub Selection_to_new_sheets()
'Create a new Sheet named as each selected cell
Set a = ActiveSheet
For Each cell In Selection
Sheets.Add(, ActiveSheet).Name = cell
Next cell
a.Select
End Sub
'--------------------------------------------------------------------------
Sub Sheet_Exists()
'check if Sheet Index exists
sName = "Sheet index"
MsgBox Evaluate("ISREF('" & sName & "'!A1)")
End Sub
'--------------------------------------------------------------------------
Sub HyperLink_SheetsToIndex()
'Adds a sheet as index to all sheets.
'The SheetSelector would be the best option
'check if Sheet Index exists, and if not, create it
sName = "Sheet index"
If Evaluate("ISREF('" & sName & "'!A1)") = True Then
Sheets("Sheet Index").Select
Else
Sheets.Add.Name = "Sheet Index"
Sheets("Sheet Index").Select
End If
'Clear all in column A
Worksheets("Sheet Index").Range("A:A").ClearContents
'Loop through all worksheets
For i = 1 To ActiveWorkbook.Sheets.Count
'Enter name of sheet to column A
Cells(i, 1).Value = ActiveWorkbook.Sheets(i).Name
'Create Hyperlink
strSubAddress = "'" & ActiveWorkbook.Sheets(i).Name & "'!A1"
strDisplayText = "" & ActiveWorkbook.Sheets(i).Name
Worksheets("Sheet Index").Hyperlinks.Add Anchor:=Cells(i, 1), Address:="", SubAddress:=strSubAddress, TextToDisplay:=strDisplayText
Next i
End Sub
'--------------------------------------------------------------------------
Sub HyperLink_SheetsToIndex_OLD()
'Adds a sheet as index to all sheets.
'The SheetSelector would be the best option
Dim wks As Worksheet
Dim rngLinkCell As Range
Dim strSubAddress As String, strDisplayText As String
Sheets.Add
ActiveSheet.Name = "Sheet Index"
'Loop through all worksheets
'Clear all current hyperlinks
Worksheets("Sheet Index").Range("A:A").ClearContents
For Each wks In ActiveWorkbook.Worksheets
Set rngLinkCell = Worksheets("Sheet Index").Range("A65536").End(xlUp)
If rngLinkCell <> "" Then Set rngLinkCell = rngLinkCell.Offset(1, 0)
strSubAddress = "'" & wks.Name & "'!A1"
strDisplayText = "HyperLink : " & wks.Name
Worksheets("Sheet Index").Hyperlinks.Add Anchor:=rngLinkCell, Address:="", SubAddress:=strSubAddress, TextToDisplay:=strDisplayText
Next wks
End Sub