Worksheets in VBA Coding and in Worksheet Formulas

Location:   http://www.mvps.org/dmcritchie/excel/sheets.htm
Home page: http://www.mvps.org/dmcritchie/excel/excel.htm
[View without Frames]

Some miscellaneous SHEET coding.  been transferred from my pathname, lastcell and buildtoc pages.

Background information on Sheets   (#intro)

Review of Worksheet Formulas

As a worksheet formula, created by Copy, Edit, paste special, Paste link
    ='## 33 ##'!$A$9
or if another workbook is involved, something like
    ='[bookone.xls]sheet 1'!$A2

Another way of creating your worksheet formula is to start by placing an equal sign on the formula bar to start a formula, then select a cell on the other sheet which could be in another open workbook.  The formula is created for you.  Return to your original sheet and hit Enter.

characters not allowed in sheetnames  : \ ? * [ ]
Sheetnames may be up to 31 characters in length.

Sheetnames in macros

To use in a macro   (note use of a single quote within double quotes in first example)
  For csht = 1 To ActiveWorkbook.Sheets.Count  'worksheet or sheets
     Cells(cRow - 1 + csht, cCol) = "'" & Sheets(csht).Name
     Cells(cRow - 1 + csht, cCol + 1) = Sheets(Sheets(csht).Name).Range("A1").Value
  Next csht
Example of calling a macro, additional information in install.htm
  Sub msgthis(sht As String)
    MsgBox sht & " -- " _
       & Sheets(sht).Range("A1").Text
  End Sub

  Sub MsgBoxAllMySheets2()
    Dim sht As Worksheet
    For Each sht In Sheets
      msgthis (sht.Name)
    Next sht
  End Sub
Another method of looping through the sheets.
  Sub MsgBoxAllMySheets()
    Dim sht As Worksheet
    For Each sht In Sheets
      MsgBox sht.name
    Next sht
  End Sub
or perhaps a little more interesting, color all formula cells
  Sub AllSheetsColorFormulas()
    Dim sht As Worksheet
    For Each sht In Sheets
      On Error Resume Next 'in case no formulas
      sht.Cells.SpecialCells(xlFormulas). _
            Interior.ColorIndex = 6
          Next sht
  End Sub
Example from Dave Peterson to **recheck link** Build an array of sheetnames, 2001-06-02
Looping through a list of sheets
   Sub ARRAY_sheetnames()
   Dim wksht As Worksheet
   Dim i As Long
         Dim wkshtnames()     'This is an array definition
    i = 0
    For Each wksht In ActiveWorkbook.Worksheets
        i = i + 1
        ReDim Preserve wkshtnames(1 To i)
        wkshtnames(i) = wksht.Name
    Next wksht

    For i = LBound(wkshtnames) To UBound(wkshtnames)
        MsgBox wkshtnames(i)
    Next i
    End Sub
Same idea but with array on the For each statement: (Tom Ogilvy, 2006-02-24, programming)
Dim cell As Range
Dim sh as Worksheet
for each sh in Worksheets(Array("X340", "X342n","X642e"))
For Each cell In sh.Range("T4:T53")
    If len(trim(cell.Text)) = 0 Then
    MsgBox "There is data missing" & cell.Address
    Application.Goto cell, True
    Cancel = True
    Exit For
    End If
Next cell
Next Sh
Create a list of Sheet Names from list in Column A, identified in Col B
 AB
1Sheet1
2Sheet two 1
3Sheet3 1
4Sheet4
5Sheet5 1
6sheet six
7Sheet7
Sub SelectSheetsBasedOn_B()
  Dim rng As Range, cell As Range
  Dim arrNames() As String, I As Long
  On Error Resume Next
  Set rng = Range("B:B").SpecialCells(xlConstants, xlNumbers)
  If Err.Number <> 0 Then
    MsgBox "Error " & Err.Number & " -- " & Err.Description
    Exit Sub
  End If
  On Error GoTo 0
  If Not rng Is Nothing Then
      'dimension to max possible names in array
      ReDim arrNames(1 To rng.Count)
      For Each cell In rng
        If cell.Value = 1 Then
           I = I + 1
           arrNames(I) = cell.Offset(0, -1).Value
        End If
      Next cell
  End If
  'reduce to names to be used
  ReDim Preserve arrNames(1 To I)
  Sheets(arrNames).Select
End Sub
Related items: Create a new sheet named with the text value of a cell with a changed value in Column F (col 6).  The new sheet will be named with the change value and will also show that text value in cell A1. [posted 2004-11-05]
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim newSht As String, oldSht  As String
    Dim wsOld As Worksheet, wsNew As Worksheet
    If Target.Column <> 6 Or Target.Row = 1 Then Exit Sub
    oldSht = ActiveSheet.Name
    Set wsNew = ActiveSheet
    newSht = Target.Text
    On Error Resume Next
    Sheets(newSht).Activate
    If Err.Number = 0 Then    'sheetname already exists
       Sheets(oldSht).Activate
       Exit Sub
    End If
    On Error Resume Next
  'Create New Sheet
    Sheets.Add After:=Sheets(Sheets.Count)  '-- place at end
    ActiveSheet.Name = newSht
    Set wsNew = ActiveSheet
    wsNew.Cells(1, 1) = "'" & newSht  'name of new sheet into cell
  '  Sheets(Sheets.Count).Activate  'try to show last tab
    Sheets(oldSht).Activate
End Sub
Remove ALL commas from text constants in all workbooks.  Warning watch out for CSV file type data.
  Option Explicit
  Sub WsReplaceLooseCommas()
     Dim ws As Worksheet
      For Each ws In ActiveWorkbook.Worksheets
      ws.Cells.SpecialCells(xlCellTypeConstants, 2). _
         Replace What:=",", Replacement:=" ", LookAt:=xlPart, _
          SearchOrder:=xlByRows, MatchCase:=False
      Next ws
  End Sub
Rename a sheet to one ending with single quote followed by double quote
      Sheets("##33##").Name = "## 33 $$'"""
Run an application: (no sheet here)
      mySum = Application.Run("MYCUSTOM.XLM!My_Func_Sum", 1, 5)
      MsgBox "Macro result: " & mySum
Examples of assigning a sheetname - leading zeros can be tricky
      ActiveSheet.Name = "01343"
      ActiveSheet.Name = Format(123, "0000")
      ActiveSheet.Name = "04-03-2001"                 ' NOT recommended doesn't sort properly
      ActiveSheet.Name = Format(Date, "mm-dd-yyyy")   ' NOT recommended doesn't sort properly
      ActiveSheet.Name = "2001-04-03"   
      ActiveSheet.Name = Format(Date, "yyyy-mm-dd")
      ActiveSheet.Name = target.Text
Example of a Change Event Macro changes Sheetname when A1 is manually changed.
     Private Sub Worksheet_Change(ByVal Target As Range)
         If Target.Address = "$A$1" Then
          On Error Resume Next
          ActiveSheet.Name = Format(Range("A1"), "yyyy-mm-dd")
          If Err.Number <> 0 Then
            MsgBox Err.Number & " " & Err.Description
            Err.Clear
          End If
         End If
         On Error GoTo 0
      End Sub

Some Sheet related coding   (#sheetcoding)

Sub Macro29()
'Every macro should have this of course...
    Application.ScreenUpdating = False 
    Application.Calculation = xlCalculationManual 
    '    ooo   Your code here   ooo 
    Application.Calculation = xlCalculationAutomatic 
    Application.ScreenUpdating = True 

'active worksheet name, address and index
    MsgBox ActiveSheet.Name & "  " & ActiveCell.Address(0, 0) & 
       "   sheet(" & Application.Caller.Parent.Index  & ")"
'Create a New Workbook containing only one sheet
                Workbooks.Add xlWorksheet
                set newwb = workbooks.add(1)
                set newwb = Workbooks.Add(xlWBATWorksheet)

'Create New Sheet
    Sheets.Add 
    Sheets.Add After:=Sheets(Sheets.Count)  '-- place at end
    Sheets.Add Before:=ActiveSheet          '-- default
    Sheets.Add After:=ActiveSheet
'Rename current Sheet
    ActiveSheet.Name = "Renamed14a"
    ActiveSheet.Name = "D" & Format(Date, "yyyymmdd")
    ActiveSheet.Name = "D" & Format(Range("a1"), "yyyymmdd")
    ActiveSheet.Name = "D" & Format(Range("a1"), "yyyy_mmdd_hhmm")
'Create New Sheet and name it NewSheet
    activeworkbook.Worksheets.Add(After:=Activesheet).Name = "NewSheet"
'Delete a sheet
    Application.DisplayAlerts = False
    '--Sheets("testing-copy").Delete
    Activesheet.Delete 
    '--ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
'Add sheet from a Template Library
    Sheets.Add Type:=Application.TemplatesPath & "\xxxxx.xlt"  '2004-05-10 Ron de Bruin 
'Activate a Sheet (what is difference activate/select)
    Sheets("Sheet14").Activate
'Select a Sheet, actually may be current sheet
    Sheets("Sheet14").Select
'Rename a Sheet, actually may be current sheet
    Sheets("Sheet14").Name = "Renamed14"
'Select an Existing Sheet
    Sheets("Map").Select
'Obtain sheetname and codename of current sheet
    msgbox activesheet.name & " codename is " & activesheet.codename
'Copy another sheet similar to using a template 
    '--manually:  Edit,  Move or Copy Sheet, be sure to check the copy)
    'copy after last tab of current workbook
    Worksheets("MyBeginning").Copy after:=Worksheets(Worksheets.Count) 
    'copy sheet from another workbook before first tab of Book2
     Workbooks("Book1").Sheets("Sheet1").Copy Before:=Workbooks("Book2").Sheets(1) 
    ActiveSheet.Name = newName
'Copy the active worksheet to just before the currently active sheet [copy sheet]
    ActiveSheet.Copy Before:=ActiveSheet
'Copy the active worksheet to after the last worksheet 
    ActiveSheet.Copy After:=Sheets(Sheets.Count)
   '-- special coding is required if some cells have more than 255 characters 
'Copy the first sheet
     Sheets(1).Copy After:=Sheets(1)    'new sheet might look like  first_sheet (2)
'Copy the last sheet
    Sheets(ActiveWorkbook.Sheets.Count).Select
    ActiveSheet.Copy after:=ActiveSheet
   '-- special coding is required if some cells have more than 255 characters

'Current position of sheet in the sheet tabs
    SheetIndex = Application.Caller.Parent.Index  '- in a function
    SheetIndex = ....construct needed for active sheet... 
'Move a specific worksheet to the front
    Sheets("Data").Move Before:=Sheets(1)  
'Move a specific worksheet to the end
    Sheets("Data").Move After:=Sheets(sheets.count)
'Select all cells on a worksheet
    cells.Select
'Select all cells on a worksheet within the used range
    ActiveSheet.UsedRange.Select
'Process all cells on a workshet within used range with text constants
    For Each cell In Cells.SpecialCells(xlConstants, xlTextValues)
         cell.Value = CDbl(cell.Value)
    Next cell
'Select an area within a worksheet
    set rng = Application.Inputbox("Select range",Type:=8)
'Select an area within a macro, with current selection as default
    Set Rng = InputBox("Select range", "TITLE1", Selection.Address(0, 0))
'Select an area within a worksheet, default current selection, redo with cursor
    Dim Rng As Range
    Set Rng = Application.InputBox("Select range", "TITLE1", _
       Selection.Address(0, 0), Type:=8)
    MsgBox Rng.Address(0, 0)
    Rng.select
    'It is seldom necessary to change the selection within a macro
    'the selection would be changed because you to see it, but the
    'macro could work with Range(Rng) just as easily as selection.range

'Recreate "testing-copy" Worksheet from "testing-skel" worksheet
    Sub testing_skel_copy()
      On Error Resume Next
      Dim svAlerts As Boolean
      svAlerts = Application.DisplayAlerts
      Application.DisplayAlerts = False
      Sheets("testing-copy").Delete
      Application.DisplayAlerts = svAlerts
      Sheets("testing-Skel").Copy Before:=Sheets("testing-skel")
      If LCase(Left(ActiveSheet.Name, Len("testing-skel"))) _
         = "testing-skel" Then ActiveSheet.Name = "testing-copy"
    End Sub

Some CELL related coding and Row / Column related as well   (#cellcoding)

'Assign a range of cells
    Range("A1:D1") = Array("Sheet Name", "A1", "B1", "C1", "textbox1")
    Rows("1:1").Font.Bold = True
    Cells(i, 1) = wkSheet.Name       -- where wkSheet is set for each sheet
    Cells(i, 2) = wkSheet.Cells(1, 1).Text
 
'Clear constants past row 1 and past column 1; leaving intact formulas, and formatting.
    On Error Resume Next
    Range("B2:" & Cells.SpecialCells(xlLastCell).Address). _
       SpecialCells(xlCellTypeConstants, xlTextValues).ClearContents
    Range("B2:" & Cells.SpecialCells(xlLastCell).Address). _
       SpecialCells(xlCellTypeConstants, xlNumbers).ClearContents

'Clear constants in a selection  (also see Insert Rows maintain formulas)
    Selection.SpecialCells(xlConstants).ClearContents
'Delete entire row
    CELLS(R,1).EntireRow.delete
    Rows(R).delete
'Delete entire column
    CELLS(1,C).EntireColumn.delete
    Columns(C).delete
'Fix lastcell after doing deletions (not a sure thing, see resetall)
    r = ActiveSheet.UsedRange.Rows.Count 'attempt fix lastcell aft deletes 
'Find firstcell in a column (see  personal.xls!GotoTopOfCurrentColumn )
    Cells(1, ActiveCell.Column).Select      
'Find lastcell in a column   (see  personal.xls!GotoBottomofCurrentColumn)
    Dim lastrow as long
    lastrow = activesheet.Cells(Rows.Count, "A").End(xlUp).Row
'Get the last row column of the used range
    lastrow = Cells.SpecialCells(xlLastCell).Row
'Top left cell of a range
    MsgBox UsedRange.Address(0,0)  '(row,column)  1=absolute
'Bottom right cell of a range
    msgbox usedrange(1)(1).offset(usedrange.rows.count-1,usedrange.columns.count-1).address(0,0)




Number of pages to be printed   (#pagenumbers)

Thought I'd include this specifically from a posting by Eric Desart since there was some question as to coding. (all quotes in these formulas are double quotes)

NumPages1 = ExecuteExcel4Macro("Get.document(50,"")")
Does Not work = gives Error

NumPages2 = ExecuteExcel4Macro("Get.document(50)")
Returns number of pages to be printed of active sheet.  (So not a good formula to use, see note)

NumPages3 = ExecuteExcel4Macro("Get.document(50,""Sheet2"")")
Returns number of pages to be printed of Sheet 2 even if not active.  

NumPages3 = ExecuteExcel4Macro("Get.document(50,""" & mysheet & """)")
Returns number of pages to be printed of variable mysheet containing the sheetname. 
Note:  Even though the syntax allows omitting a workbookname and sheetname, you should include it or you may be referring to the wrong sheet. (see Filename in a Cell, when the sheetname is omitted and the active sheet is used).
NumPages4 = ExecuteExcel4Macro("Get.document(50,""[TEST.XLS]Sheet3"")")
Returns number of pages to be printed of File TEST.XLS Sheet 3 even if
not active.
Of possible interest: 

Check for Existence of a Sheet before creating   (#existence)

The following came from a posting by Chip Pearson 23Oct1999 in programming.
Function WorksheetExists(WSName As String) As Boolean
    On Error Resume Next
    WorksheetExists = Len(Worksheets(WSName).Name) > 0
End Function

Then, in your code,

If WorksheetExists("Summary") = True Then
    MainMacro
Else
    CreateSummarySheet
End If

Check for Existence of a Sheet -- Worksheet Solution

 ABC
1SHeet71TRUE =NOT(ISERR(INDIRECT("'" & A1 & "'!A1")))
2sheet71TRUE =NOT(ISERR(INDIRECT("'" & A2 & "'!A1")))
3sheet81FALSE =NOT(ISERR(INDIRECT("'" & A3 & "'!A1")))
4(empty)FALSE =NOT(ISERR(INDIRECT("'" & A4 & "'!A1")))

Naming NEW sheets   (#newsheets)

Code posted in programming group by David Phillips 2000-06-12, setting value to Nothing is a memory issue.
Sub AddNewSheet()
   Dim xlSheet As Worksheet
   Set xlSheet = ActiveWorkbook.Sheets.Add
   xlSheet.Name = "My New Worksheet"
   Set xlSheet = Nothing
End Sub

Creating a series of sheets based on a master sheet (#master)

The following is a rather interesting example posted by Don Guillet (2005-08-28, programming) The macro is renaming the copied sheet with a name of "Master (2)" to "Master1", and then "Master2", etc.
Sub MasterCopies()
Dim i As Long
Application.ScreenUpdating = False
  For i = 1 To 10
    Sheets("Master").Copy After:=Sheets(Sheets.Count)
    Sheets("Master (2)").Name = "D" & Format(i,"000")
Next
Application.ScreenUpdating = True
End Sub
Sub MatchWStoA1()
 '//  Find cell A1 that contains  Customer Name
 '//  David McRitchie   2000-07-15 programming for L.Wong
  Dim cn As String, cn2 As String, ws As Worksheet
  cn = InputBox("Enter customer name, as found in cell A1")
retry:
  If cn = "" Then Exit Sub
  cn = Trim(LCase(cn))
  Dim cn3 As String
  cn3 = cn
  For Each ws In ActiveWorkbook.Sheets
     cn2 = Trim(LCase(Sheets(ws.Name).Range("A1").Value))
     cn2 = Replace(cn2, Chr(160), "")
     If cn2 = cn Then         'HELP, Working with Active Cell
        Worksheets(ws.Name).Activate    'must do this first
        Worksheets(ws.Name).Range("A1").Activate
        Exit Sub
     End If
  Next ws
  cn = InputBox(cn & " -- Not Found" & Chr(10) & _
         "REENTER Customer name, or hit [Cancel]")
  GoTo retry
End Sub
I also included this comment.

I think this is going to drive people crazy why not rename the sheets with the customer name or at least build a table of contents with information. See my buildtoc.htm page all you need to do is add content of cell A1 from each sheet.  You will also find information there for sorting sheetnames.

Scroll for position in window of active cell   (#scroll)

Display Cell A1 in upper left corner of sheet

The following was to protect sheet from accidentally deleting any data in the active range.
  Sub Macro35()
    'Select cell without data and display top left corner of sheet
    'Dim lastrow As Long
    'lastrow = Cells.SpecialCells(xlLastCell).Row
    'Range(Cells(lastrow + 1, 1), Cells(lastrow + 1, 1)).Select
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.ScrollRow = 1
  End Sub

Display Active cell in upper left corner of sheet

  Sub Macro35()
    ActiveWindow.ScrollColumn = ActiveCell.Column
    ' ActiveWindow.ScrollColumn = 1
    ActiveWindow.ScrollRow = ActiveCell.Row
  End Sub
The following would use another sheet with the address to navigate to.

Note both A23 and A24 refer back to G23, so you cannot write a program directly reversible as where to go backwards in the macro from G23.

Sheet24_Nav
A23:  =Sheet24!G23
G23:  =Sheet24!A23
A24:  =Sheet24!G23



Sheet24
select  C23  and run macro, goes to next cell because
    no formula in sheet24_nav!C23
select  A23  and run macro,  goes to G23, because
    sheet24_nav!A23 contains formula  =Sheet24!G23

Sub NavigateToFormulaOn_Nav()
    Dim sFormula As String
    On Error GoTo notgood
    sFormula = Worksheets(ActiveSheet.Name & "_nav"). _
         Range(ActiveCell.Address).Formula
    If Left(sFormula & " ", 1) <> "=" Then GoTo notgood
    Range(Mid(sFormula, 2)).Activate
    Exit Sub
notgood:
    ActiveCell.Offset(0, 1).Activate
End Sub

Navigation to a Sheetname (#moresheets)

Brings up list of sheetnames, this is the same list you get by right-clicking on a sheet navigation arrow button and then selecting "More Sheets...".  You can place the following on a shortcut key combination.  [ref. Chip Pearson & Dave Peterson]   Also see thread for a list of sheetnames in a listbox on a FORM.
Sub SheetList_CP()
  'Chip Pearson, 2002-10-29, misc., %23ByZYZ3fCHA.1308%40tkmsftngp11 
  'Dave Peterson, same date/thread, 3DBF0BA8.4DAE9DA0%40msn.com
  On Error Resume Next
  Application.CommandBars("Workbook Tabs").Controls("More Sheets...").Execute
  If Err.Number > 0 Then
    Err.Clear
    Application.CommandBars("Workbook Tabs").ShowPopup
  End If
  On Error GoTo 0
End Sub
More on Sheet navigation on my Toolbars and Build TOC pages, and of course the More Sheets listing is easier to work with if the sheets have been sorted alphabetically by sheet name.(SortAllSheets).

You can hold the shift key down click on the worksheet tab navigation arrows to shift over to the next set of worksheet tabs currently out of sight.

Some Loops through Worksheets   (#loopsheets)

These are example only, the msgbox will sort of fail on you if you have many sheets,

The LoopThru which resembles your original will reach a limit on characters in the msgbox -- limit varies by version.

The LoopSheet will fail to show all sheets because due to limit or failure to be able to show another box after the first fills up the monitor window.

More useful examples can be found in
Build Table of Contents and optionally sort worksheets
http://www.mvps.org/dmcritchie/excel/buildtoc.htm


Option Explicit
Public Sub LoopThru()
Dim mostofthem As String
Dim sheet As Variant
For Each sheet In ActiveWorkbook.Sheets
    mostofthem = mostofthem & sheet.Name & ", "
Next sheet
MsgBox mostofthem
End Sub

Public Sub LoopSheets()
  Application.Calculation = xlManual   'xl97 up use xlCalculationManual
  Application.ScreenUpdating = False
  Dim mostofthem As String
  Dim csht As Long
  mostofthem = ""
  For csht = 1 To ActiveWorkbook.Sheets.Count  'worksheet or sheets
     mostofthem = mostofthem & Sheets(csht).Name & Chr(10)
  Next csht
  MsgBox mostofthem, , "names of sheets"
  Application.ScreenUpdating = True
  Application.Calculation = xlAutomatic   'xl97 up use xlCalculationAutomatic
End Sub

Public Sub LoopShorter()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        MsgBox ws.Name
        '   ws.Protect password:="AnyThing"
    Next ws
End Sub

 Sub Martin002()
     'place 'Martin 0'!A1 value into distinct sheets
     Dim x As Variant
     Dim sht As Variant
     x = Array("Martin 1", "Sheet2", "MSFT")
     Sheets("Martin 0").Activate
     For Each sht In x
       Sheets(sht).PageSetup.LeftHeader = ActiveSheet.Cells(1, 1)
     Next sht
 End Sub

Rename Sheet   (#rename)

 Sub RSHEET()
   'Rename Sheet,  D.McRitchie, 2001-04-05 programming
     Dim xStr As String
retry:
     Err.Clear
     xStr = InputBox("Supply new name for old sheet,  blah," _
       & "blah,blah", "Rename Sheet", ActiveSheet.Name)
     If xStr = "" Then Exit Sub
     On Error Resume Next
     ActiveSheet.Name = xStr
     If Err.Number <> 0 Then
        MsgBox Err.Number & " " & Err.Description
        Err.Clear
        GoTo retry
     End If
     On Error GoTo 0
     '... continue......
 End Sub

Delete Active Sheet if name begins with "sheet" DelSht - Delete Sheet  (#DeleteThisSheet)

To help quickly clean up some testing.  Will delete sheets with names beginning "sheet" without verification.  Other sheets will be deleted only when you reply to the normal message. 

An exception for sheets with program code -- they will not be deleted nor will you be asked if you want to delete them. 

I have buttons to go through the sheet tabs, Previous Sheet  Next Sheet  navigating to the Previous and Next described in BuildTOC, but you can use Ctrl+PageUP (to left) and Ctrl+PageDN (to right).  The Toolbar icon for this macro DelSht - Delete Sheet is included on the toolbars page.  Coding is with code/buildtoc.txt rather than code/sheets.txt

Sub DeleteThisSheet()
   Dim ans As Variant
   Dim saveTrue As Variant
   Dim sheetcodelines As Long
   '--requires ref. to the MS VBA Extensibility' library
   sheetcodelines = ActiveWorkbook.VBProject.VBComponents _
         (ActiveSheet.CodeName).CodeModule.CountOfLines
   If sheetcodelines > 2 Then
      MsgBox ActiveSheet.Name & " -- has " & _
         sheetcodelines & " lines of code (not deleted) "
   ElseIf Left(ActiveSheet.Name, 5) = "Sheet" Then
      Application.DisplayAlerts = False
      ActiveSheet.Delete
      'tflush_wav
      Application.DisplayAlerts = True
   Else
      Application.DisplayAlerts = True
      ActiveSheet.Delete
   End If
End Sub
might change the line above
   ElseIf Left(ActiveSheet.Name, 5) = "Sheet" then
to the following to treat empty sheets the same as sheets beginning with "Sheet":
   ElseIf Left(ActiveSheet.Name, 5) = "Sheet" _
         Or Application.WorksheetFunction.CountA(ActiveSheet.Cells) = 0 Then

Delete Empty Sheets (#delete_emptysheets)

I don't expect that I have any but here is code from Ron de Bruin to delete empty sheets.  Coding is similar to John Walkenbach's delete empty rows, which also uses CountA.  Note the suggestion to modify DeleteThisSheet above is based on Ron's posting.
Sub Delete_EmptySheets()
    Dim sh As Worksheet 'Ron de Bruin, programming, 2002-12-28 
    For Each sh In ThisWorkbook.Worksheets
      If Application.WorksheetFunction.CountA(sh.Cells) = 0 Then
        Application.DisplayAlerts = False
        sh.Delete
        Application.DisplayAlerts = True
      End If
    Next
End Sub

Linked files in Excel   (#linked)

The first line is the way a link displays,
the second line is how you might type it in
the third line is how you might code the line for use in INDIRECT
the fourth line invokes a user defined function (UDF)
 D:\myfolder\excel\TAXES\myfile.xls - checking!B600
 d:\myfolder\excel\taxes\myfile.xls[checking]!b600
 ="d:\myfolder\excel\taxes\" & A14 & "["& A15 & "]!"&"b600"
 =myfile.xls!getformula(B2)

VBA gotocell reference   (#gotocell)

Similar VBA code is used to goto a cell (see BuildTOC), go to a macro (see GoToCell).
 Application.Goto Reference:="sheetaa!C14"

VBA goto subroutine/macro/function   (#goto) ref.

See GoToSub

Application.Goto Reference:=ActiveCell.Value

Application.Goto Reference:=Mid(ActiveCell.Formula, 2, i - 2)

This topic was copied from buildtoc.htm, where additional similar information can be found, including information on how to display hyperlink information.  Be sure to see the next topic down on this page taking the references out from within quotes.
Worksheet code that created a hyperlink
=HYPERLINK("[c:\temp folder\xyz abc.xls]'Sheet One'!$C$5","Sheet One")
     [http://www.mvps.org/dmcritchie/excel/excel.htm]","My Excel Pages")
=HYPERLINK("file:\\\c:\temp\David McRitchie\a.txt","thisone is good")
=HYPERLINK("mailto:DMcRitchie%20%6Dsn.com","David McRitchie")
It appears that even if the link is to a cell in the same worksheet you must include the bookname including .XLS extension, as well as the sheetname.
  =HYPERLINK("[WBName.xls]Michael!C5", "Michael I")

Until someone pointed out that you can use the pound sign (#)

By including the "#" the pathname can be left off, these work: in Excel 2000, and as I understand from Excel 97 and up, but these references are frozen within double quotes.  See the next topic to take the references out from within the quotes.
  =HYPERLINK("#C5",C5)
  =HYPERLINK("#Sheet34!E6",Sheet34!E6)
  =HYPERLINK("#'My Sheet'!E6",Sheet34!E9)

Since the above links are within double quotes they will not adjust when you insert or delete rows or columns.  Double quotes also impairs several of the other examples on this page.  Even absolute addresses would change when inserting or deleting rows/columns but not things within quotes.  To take care of that use...

The HYPERLINK Worksheet Formula can be used to refer to a cell on the same worksheet.  The CELL Worksheet Function can be used to insure that you can refer to a relative address that survives insertion/deletion of rows/columns since it is not frozen within double quotes.
  =HYPERLINK("#"&CELL("address",C5),C5)
  =HYPERLINK("#"&CELL("address",sheetone!C5),sheetone!C5) 
  =HYPERLINK("#"&CELL("address",'sheet two'!C5),'sheet two'!C5) 
No address cell is within double quotes so the formulas will adjust if you insert/delete rows or want to use the fill-handle.

 ABCD
1 D4=HYPERLINK("#"&C3,C3) D3D1-value
2 D4-value =HYPERLINK("#"&C3,INDIRECT(C3))C2D2-value
3 D4-value =HYPERLINK("#"&CELL("address",D4),D4) D4D3-value
4 D3-value=HYPERLINK("#D3",D3) C4D4-value
D4:   =HYPERLINK("#"&CELL("address",A3),"D4-value")

To hyperlink and display the Cell in the B column same row of the Notes sheet
  =HYPERLINK("#"&CELL("address",OFFSET(Notes!B1,ROW()-1,0)), OFFSET(Notes!B1,ROW()-1,0))

To hyperlink to a more descriptive longer note on the same row, but in the B column of the Notes worksheet.
  =HYPERLINK("#"&CELL("address",OFFSET(Notes!B1,ROW()-1,0)), "Click for note")

To hyperlink to the Note in Column B same row on Notes sheet, but display the short description in Column A of the Notes sheet.
  =HYPERLINK("#"&CELL("address",OFFSET(Notes!B1,ROW()-1,0)), OFFSET(Notes!A1,ROW()-1,0))

To refer to a cell in Column D (col 4) of the same sheet at a specific Row OFFSET to the row
  =HYPERLINK("#" & ADDRESS(ROW()+41,1,4),"next week")
takes you down 41 rows to the first column, so the formula can be in any cell on the row.  The 4 indicates a relative address result, but it really doesn't matter if absolute or relative since it is created during recalculation. Will allow you to put the formula on any cell in the row , the link will take you 41 rows below and to the first column.

Some alternatives to Hyperlinks within a worksheet or within a workbook

CELL is a Volatile function, but worksheet volatile functions do not present the serious slowdowns that Volatile User Defined (VBA) Functions can have.

xlindex.htm is a sheet on my page, on my HD and on my website xlindex is also a sheet in my vlookup.xls file the following examples show Column B what you see, Col C is the formula, and "C5-1" is the value in cell c5 on sheet xlindex

 ABC
1xlindex  'xlindex'!C5 =HYPERLINK( "#" & A1 & "!C5","'" & A1 & "'!C5")
2xlindex xlindex!C5 =HYPERLINK("#'" & A2 & "'!c5",A2 & "!C5")
3xlindex xlindex!C5 =HYPERLINK("#xlindex!c5",A3 & "!C5")
4xlindex C5-1 =HYPERLINK("#xlindex!c5",xlindex!C5)
5xlindex 'xlindex'!C5 =HYPERLINK("[vlookup.xls]'" & A5 & "'!C5","'" & A5 & "'!C5")
6xlindex xlindex =HYPERLINK("file://x:/mywebsite/dmcritchie/excel/" & A6 & ".htm",A6)
7xlindex xlindex =HYPERLINK("http://www.mvps.org/dmcritchie/excel/" & A7 & ".htm",A7) 
8(same sheet) C5-1 =HYPERLINK("#"&CELL("address",C5),C5) 

Values in RED are shown as constants if used in an actual formula referring to cells in the same workbook the formula is reduced to the formula shown immediately below -- no changes occur within double-quotes.

 AB
1Value =PERSONAL.XLS!Getformula(cell)
2  '-- using Excel 2000 9.09.6926 SP-3
3A18-Value='Menu Sheet'!A18
4(--->) '='C:\temp\[project_text.xls]Menu Sheet'!A19
5A18-Value ='Menu Sheet'!A18
6A18-Value =HYPERLINK("[project_text.xls]'Menu Sheet'!a18", 'Menu Sheet'!A18)
7A18-Value =HYPERLINK("[c:\temp\project_text.xls]'Menu Sheet'!a18", 'Menu Sheet'!A18)
8A18-Value =HYPERLINK("c:\temp\project_text.xls#'Menu Sheet'!a18", 'Menu Sheet'!A18)
9(--->) '=HYPERLINK("[c:\temp\project_text.xls]'Menu Sheet'!a18", 'C:\temp\[project_text.xls]Menu Sheet'!A18)
10A18-Value =HYPERLINK("[c:\temp\project_text.xls]'Menu Sheet'!a18", 'Menu Sheet'!A18)

Hyperlink to a MATCH (#hyperlinkmatch)

Hyperlink to a value in a table.

=HYPERLINK("#"&ADDRESS(MATCH("xyz",B1:B13),2), "xyz" )

You are looking for the value "xyz" (not case sensitive)  in B1:B13  

if you don't want to see #N/A then insert the failing part of the formula and the formula as follows:
=IF(ISERROR(MATCH("xyz",B1:B13,0)), "N/A", HYPERLINK("#"&ADDRESS(MATCH("xyz",B1:B13,0),2), "xyz" ))

Don't ask me why the second formula hyperlink works but does not show up as a hyperlink, I don't know.

You should look up ADDRESS Worksheet Function and the MATCH Worksheet Function in HELP for some details.

Using HYPERLINK Worksheet Function to also pull in associated link (#vlookup)

Add another column to your table with the hyperlink.  You can extract the hyperlink on your Lookup sheet with a User Defined Function hyperlinkaddress. . On lookup sheet
J1: =personal.xls!hyperlinkaddress(A1)

On your sheet with VLOOKUP
  =HYPERLINK(VLOOKUP(B8,Lookup!A1:Lookup!J1203,10,FALSE), VLOOKUP(B8,Lookup!A1:Lookup!J1203,3,FALSE) )

Additional Examples with mailto:...   (#mailto)

  =HYPERLINK("Mailto:" & B2, A2)
  =HYPERLINK("Mailto:" & B2,"[x]")
  =IF(ISERROR(SEARCH("@",B2)),"","mailto:" & HYPERLINK(B2))
  =IF(ISERROR(SEARCH("@",B2)),"",HYPERLINK("mailto:" & B2,"[x]"))
To extract a hyperlink see hyperlinkaddress and other User Defined Functions in buildtoc.htm#url.

Using HYPERLINK Worksheet Function where workbook name can change   (#internal)

As aready mentioned you must include the filename, even if it refers to a cell in the same workbook.  You can use this code to generate the workbook name.  As mentioned on my Pathname page you must include the cell reference to get a valid result from the CELL Worksheet Function. 

B3:  =MID(CELL("filename",A1),FIND("[",CELL("filename",A1),1)+1,FIND("]",CELL("filename",A1),1)-FIND("[",CELL("filename",A1),1)-1)

and use it as follows:
A1:  =HYPERLINK("["&hyperlink!$B$3 & "]'Sheet One'!A1","Sheet One")

Update:
But as updated in blue above, the following would be used within same sheet and would allow renaming/moving workbook without changing formulas.  (works in XL97 and up)
  =HYPERLINK("#"&CELL("address",C5),C5)
or within same workbook
  =HYPERLINK("#"&CELL("address",sheet7!C5),sheet7!C5)

Problem: One of the sheets in the workbook is named 'HelpMe', and the user wants to be able to use a link button or other means to get to that page and to return back where they came from.

Solutions:
If you use a hyperlink or if in a macro you use FollowHyperlink Address you use hyperlinkaddress you can use the web BACK key (Alt+ArrowLeft) to return. You can install the buttons on your toolbar from tools, customize, commands, Web, and drag the two buttons BACK and FORWARD to the toolbar. Invoke as a button on Worksheet
If your button is on the worksheet you can hyperlink to you help worksheet.  I don't think you can do that you can assign a hyperlink directly to a toolbar button without having it invoke a macro instead.

Invoke as a HYPERLINK Worksheet Function from the worksheet
  =HYPERLINK("[workboo14.xls]helpme!a5","help")
  =HYPERLINK("#helpme!E6","help")
  =HYPERLINK("#"Help Me'!A1","help")

Invoke as an object type hyperlink [Ctrl+K]
Object hyperlinks (Ctrl+K) will =change automatically if you rename the worksheets, but can be burdomsome on older versions of Excel. (Pre 2000 on Win 98).

Invoke link as a DoubleClick Event macro from the worksheet

  Private Sub Worksheet_BeforeDoubleClick(ByVal _
      Target As Range, Cancel As Boolean)
    'to install -- right-click on the sheettab of the sheet to
    ' be used in and choose 'view code'.   Paste this Worksheet
    ' event macro into the module.
    Cancel = True   'Get out of edit mode
    Dim xx As String
    xx = "#'Help Me'!E6"
    ActiveWorkbook.FollowHyperlink Address:=xx, NewWindow:=False
  End Sub

Link to a Chart or Shape, faked by an Event Macro
Hyperlinks in Excel, Jon Peltier, some notes on hyperlinks including how to fake a link to a chart (or other shapes).

To Return to original worksheet:
As mentioned at the beginning you can return with the Keyboard Shortcut   ALT+ArrowLeft   or with the Toolbar BACK button that can be installed on your toolbar as previously described.

This topic was a little hard to decide whether to put on this webpage (sheets.htm), or on my Build Table of Contents webpage, or on Event Macros webpage as another example, or even perhaps the Shortcuts webpage because of the BACK button.

Link Excel into HTML or MS Word (#linkexcel)

for MS Word as C:\My Documents\excel\book1.xls#sheet1!c9
for HTML as <a href="c:\temp\mybook.xls#sheet1!c9">worksheet 1</a>

Can't get the above HTML link to work in Firefox, let alone with a space in the sheetname with Firefox.
  <a href="file:///C:\bk1\h\excel2k\2004-11.xls#Sheet16!d2">d2 in sheet 16</a> -- d2 in sheet 16

	'h:\excel2k\[vlookup.xls]sheet13'!C4

3-D references   (#d3)

The following will SUM the cells D3:G3 from the range of sheets as seen in the worksheet tabs at the bottom:  Sheet5:Sheet8
  ='sheet5':'sheet8"!D3:G3  

the following will SUM the cells D3:G3 in each of the sheets named in the cells L3:P3   (Dominic 2005-05-05, misc) -- You will get a #REF! error if any sheetname is missing or is invalid in the L3:P3 range.
  =SUMPRODUCT(SUMIF(INDIRECT("'"&L3:P3&"'!D3:G3"),"<>"))

Some Worksheet Examples using INDIRECT   (#indirect)

   ='Worksheet 1'!G3
   =INDIRECT("Worksheet 1'" & "!" & "G3")
   =INDIRECT("'Worksheet 1'" & "!G" & h4)
   =INDIRECT("'c:\My Documents\[WTA " & Year(Now())-1 & ".xls]Sheet1'!$B$4")
   =INDIRECT("["&D2&".xls]'Sheet1'!$A$1")
The above is hard to read, single quotes surround the worksheet name because it includes a blank. All the rest are double quotes.

INDIRECT will not work for closed files.

Extended one step further using the sheetname in cell A1:

   =INDIRECT("'" & A1 & "'" & "!" & "G" & H4)
which now includes a single quote within double quotes around the sheetname specified in cell A1. You can simplify the formulas by combining text together in all of the above (hope you can read it).
   =INDIRECT("'" & A1 & "'!G" & H4)
Additional examples involving replication can be found on my Fill Handles page.
   =LARGE($A$1:$A$10,ROW(1:1))

INDIRECT to refer to a cell in another workbook (actually used same workbook, can you tell?)

 ABCDEFG
1'h:\excel2k\ [vlookup.xls]sheet13'!c4 Example'h:\excel2k\[vlookup.xls]sheet13'!c4
2h:excel2kvlookup.xls sheet13C4Example 'h:\excel2k\[vlookup.xls]sheet13'!C4
3        
4   Example     

Note cell A1 and E1 show a single quote but you must type in an additional single quote before the one you see.

A1 =getformula(INDIRECT(A7))   
A1'h:\a2h:
b1excel2k\b2excel2k
c1[vlookup.xls]c2 vlookup.xls
d1sheet13d2sheet13
e1'!c4e2C4
f1=INDIRECT(A1&B1&C1&D1&E1)f2 =INDIRECT("'" & A2 & "\" &B2 & "\[" &C2 & "]" &D2& "'!" &E2)
g1=A1&B1&C1&D1&E1g2 ="'" & A2 & "\" &B2 & "\[" &C2 & "]" &D2& "'!" &E2
f1=Example f2=Example
g1='h:\excel2k\[vlookup.xls]sheet13'!c4 g2='h:\excel2k\[vlookup.xls]sheet13'!C4

another example:
Sheetnames are in Column C (cells C1:C50),  The sheets that hae a model number of "ModelA" in their A3 cell are to have the value of their H31 cells totalled in the formula. [Bob Phillips, .excel, 2006-05-31]
=SUMPRODUCT(SUMIF(INDIRECT("'"&C1:C50&"'!A3"),"ModelA",INDIRECT("'"&C1:C50&"'!H31")))

Additional examples of INDIRECT can be found on my Build Table of Contents page.

Last sheet Created   (#lastsheet)

The last sheet created can be identified in VBA from it's Worksheet Count.  Norman Harker 2001-06-12))
     LastSheetName = Worksheet(Worksheets.Count))
The last sheet updated can be identified with the crippled  =CELL("Filename") until a recalcuation occurs, but that is a very unstable form and I expect it is related to serious problems.  There is no problem with =CELL("filenname",A1) which returns the Filename (including full path) of the file that contains reference, as text. Returns empty text ("") if the worksheet that contains reference has not yet been saved.

Referencing a Relative Worksheet Name in a Workbook   (#relsheet)

The following formula will obtain the sheetname in the current workbook.
Function RelSheet(sht As Long) As String
  RelSheet = Worksheets(sht).Name
End Function

Function WB_Sheet_cell(wb As String, sht As Long, cell As String) As String
  WB_Sheet_cell = Workbooks(wb).Worksheets(sht).Range(cell)
End Function
  =wb_sheet_cell("MP1.xls",1,"$A$2")
 where   MP1.xls   is your other workbook
 where   1   is the relative worksheet number
 where   $A$2   is the cell in the other workbook's relative sheet 1.

DisplayFormula
$$ TOC=relsheet(1)
'$$ TOC'!b2 ="'" & relsheet(1)&"'"&"!b2"
Type =INDIRECT("'" & relsheet(1)&"'"&"!b2")
Type =wb_sheet_cell("martin_hyperlinks.xls",1,"b2")
C:\temp\[martin_hyperlinks.xls]Sheet20 =CELL("filename",A1)
#VALUE! =wb_sheet_cell(CELL("filename",A1),1,"b2")
Type =wb_sheet_cell(MID(CELL("filename",A1),FIND("[", CELL("filename",A1),1)+1,FIND("]",CELL("filename",A1),1) -FIND("[",CELL("filename",A1),1)-1),1,"b2")

HTML HREF=   (#href)

<a href=file:///C:/temp/rls0825.xls#'savehistory'!a3>cell A3</a>

my own test: cell A3

Workbook   (#workbook)

This webpage is for sheet coding, but here is some code for workbooks.

Open a workbook from named in cells

Open workbooks in current range down from A1.
For Each cell In Range("A1", Range("a1").End(xlDown))
    Workbooks.Open (cell & ".xls")
Next

Conditionally Open a workbook

Dim oWB As Workbook  'posted by Bob Phillips, 2004-02-15, misc
    On Error Resume Next
        Set oWB = Workbooks("myBook")
    On Error GoTo 0
    If oWB Is Nothing Then
        Set oWB = Workbooks.Open("C:\myDir\myBook.xls")
    End If
    oWB.Worksheets("Sheet1").Activate

List the names of the open workbooks

See Looping through a set of workbooks listed in a range may not be an exact match but you can see coding.  Also see collections page.

Create folder and save file

The following will create a folder from the value in C3 on Sheet1 and save the file, by the same name in that folder. It will ignore a folder already being in existence, but will warn you if a file in there with the same name is about to be overwritten
Sub CreateFolderAndSaveFile()
'Nick Hodge, 2000-06-12 microsoft.public.excel.worksheet.functions
Dim fName As String
On Error Resume Next
fName = ThisWorkbook.Worksheets("Sheet1").Range("C3").Value
MkDir ("C:\Projects\" & fName & "\")
ChDir ("C:\Projects\" & fName & "\")
ThisWorkbook.SaveAs Filename:=fName
End Sub

Generate Sheets with sheetnames named from current selection of cells

Set up to generate sheetnames for dates, but easily changed to just do constants with   activesheet.name=cell.text   as needed.
Sub genWStabnames()
    Dim cell As Range
    Dim newName As String, xx As String
    Err.Description = ""
    On Error Resume Next
    For Each cell In Selection
       Worksheets.Add
       If Err.Description <> "" Then Exit Sub
       MsgBox Format(cell.Value, "yyyy-mm-dd")
       Err.Description = ""
       newName = Format(cell.Value, "yyyy-mm-dd")
       ActiveSheet.Name = newName
       If Err.Description <> "" Then
          '--failed to rename, probably sheetname already exists...
          xx = MsgBox("Failed to rename inserted worksheet " & _
           vbLf & _
           ActiveSheet.Name & " to " & newName & vbLf & _
           Err.Number & " " & Err.Description, vbOKCancel, _
           "Failure to Rename Worksheet:")
          '--eliminate already created sheet that was to be renamed...
          Application.DisplayAlerts = False
          ActiveSheet.Delete
          Application.DisplayAlerts = True
          '--check for immediae cancellation...
          If xx = vbCancel Then Exit Sub
          Err.Description = ""
       End If
    Next cell
End Sub

Miscellaneous   (#misc)

The following is just some code that I did not want to lose track of:

And if the macro is exited with any of these things in effect is there any way of telling what's wrong or just resetting it,

    Application.Interactive = False      'prevents user interference with the macro
    Application.DisplayAlerts = False  'suppress prompts and alerts
    Application.ScreenUpdating = False  'suppress screen repainting
    ActiveWindow.Visible = False     'hides the active window
I thought the following would put things back to normal, but after rereading the switches, I don't think it would change. I turned off macros and fixed the interactive once, but more interested in if you don't know what happened.

"C:\Program Files\Microsoft Office\Office\Excel.exe" /regserver change path as needed or just use Excel.exe /regserver

291288 - Startup Switches for Microsoft Excel (2002: 291288, 2000: 211481; 97: 159474) (SAFE Mode, Re-register/Reregister Excel extensions)
  http://support.microsoft.com/default.aspx?scid=kb;en-us;Q159474

Misc other short things

'Clear the clipboard, if copied from the worksheet
    Application.CutCopyMode = False
Otherwise see Chip Pearson's page on the Clipboard for some Windows API.

Worksheet Tabs, and Linking (#hyp_ws_tabs)

A link to a worksheet using the HYPERLINK Worksheet Formula will fail when the worksheet is renamed because it is a constant within double quotes.  A solution to this problem is to use a VBA Function.  See details in solution by Bill Manville, and in the extensive examples above in Hyperlink Worksheet References outside of quotes
    =HYPERLINK("#'sheet67'!a1","'sheet67'!A1)
    =HYPERLINK("#'" & XLName("Sheet67")& "'!$A$1",XLName("Sheet67")& "!$A$1")
  Function XLName(stVBASheet As String) As String
    Dim WS As Worksheet  'Bill Manville, 2003-02-20, links
    Application.Volatile
    For Each WS In Application.Caller.Parent.Parent.Worksheets
      If WS.CodeName = stVBASheet Then
        XLName = WS.Name
        Exit Function
      End If
    Next
  End Function

Relative Hyperlinks and Hyperlink Base (#relative)

With a need to hyperlink to a lot of files such as PDF files in the same directory as the Excel workbook, you could specify the pathname in a cell on a specific sheet and then use the HYPERLINK worksheet function.

But the use of the Hyperlink Base in workbook properties can be used effectively, see thes postings by Harlan Grove. 2002-04-22 and this one to access the hyperlink property 2002-04-26

Hidden worksheets (#hidden)

See VBE Help for "Visible Property" having to do with worksheets and there is also a xlveryhidden
 
Worksheets("Sheet1").Visible = False
Worksheets("Sheet1").Visible = True
sht.visible = True

Missing Scrollbars or Worksheet Tabs   (#missing)

Things beginning with #-sign (#hash)

Build Table of Contents (#BuildTOC) primarily deals with Listing Sheetnames, hyperlinks, and other documentation things.

Build Table of Contents (#BuildTOC) also has many sheet related items, in addition to some of the above.

Master Sheet, creation   (#mastersheet)

Cells, Cells related coding

PathName

Slow Response


You are one of many distinguished visitors who have visited my site here or in a previous location  since created on Oct 22, 1999.  Return to TOP.

 

Visit [my Excel home page]   [Index page]   [Excel Onsite Search]   [top of this page]

Please send your comments concerning this web page to: David McRitchie send email comments


Copyright © 1997 - 2006,  F. David McRitchie,  All Rights Reserved