Some miscellaneous SHEET coding. been transferred from my pathname, lastcell and buildtoc pages.
To use in a macro that is a single quote within double quotes
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
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
Build an array of sheetnames, 2001-06-02
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
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"
ActiveSheet.Name = Format(Date, "mm-dd-yyyy")
ActiveSheet.Name = Format(Date, "yyyy-mm-dd")
ActiveSheet.Name = target.Text
Sub Macro29()
'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
'Rename current Sheet
ActiveSheet.Name = "Renamed14a"
ActiveSheet.Name = "D" & Format(Date, "yyyymmdd")
ActiveSheet.Name = "D" & Format(Range("a1"), "yyyymmdd")
'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
msgbos activesheet.name & " codenam is " & activesheet.codename
'Create a copy of current sheet, just before current sheet
ActiveSheet.Copy Before:=ActiveSheet
'Copy the latest sheet
Sheets(ActiveWorkbook.Sheets.Count).Select
ActiveSheet.Copy after:=ActiveSheet
'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
End Sub
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.
NumPages3 = ExecuteExcel4Macro("Get.document(50,""Sheet2"")")
Returns number of pages to be printed of Sheet 2 even if not active.
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.
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
Sub AddNewSheet() Dim xlSheet As Worksheet Set xlSheet = ActiveWorkbook.Sheets.Add xlSheet.Name = "My New Worksheet" Set xlSheet = Nothing 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.
Sub Macro35()
'Select cell without data and display top left corner of sheet
'Dim lastrow As Integer
'lastrow = Cells.SpecialCells(xlLastCell).Row
'Range(Cells(lastrow + 1, 1), Cells(lastrow + 1, 1)).Select
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
End Sub
Sub Macro35()
ActiveWindow.ScrollColumn = ActiveCell.Column
' ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = ActiveCell.Row
End Sub
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
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 Integer
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
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
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,
navigating to the Previous and Next sheets as described in
BuildTOC,
but you can
use Ctrl+PageUP (to left) and Ctrl+PageDN (to right)
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
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)
Application.Goto Reference:="sheetaa!C14"
Application.Goto Reference:=ActiveCell.Value
Application.Goto Reference:=Mid(ActiveCell.Formula, 2, i - 2)
Worksheet code that created a hyperlink=HYPERLINK("h:\excel2k\testng2k.xls#sheet3!a1","SHEET3") =HYPERLINK("[h:\excel2k\testng2k.xls]sheet3!a1","SHEET3") =HYPERLINK("[d:test\test.xls]test!b5","thisone good b5") =HYPERLINK("d:\website\dmcritchie","dmcr") =HYPERLINK("d:test\test.xls","thisone is also good") =HYPERLINK("[testng2k.xls]'$$TOC'!A56","heidi-ho $$TOC!A56") =HYPERLINK("[h:\excel2k\testng2k.xls]'$$TOC'!a3","text in a3 in $$TOC") =HYPERLINK("[file:\\\d:test\test.xls]test!B3","thisone is good") =HYPERLINK("[http://www.business.com/report/budget report.xls]Annual!F10","Report") =HYPERLINK("[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@msn.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!A5", "Michael I")
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
A B C 1 xlindex 'xlindex'!C5 =HYPERLINK( "#" & A1 & "!C5","'" & A1 & "'!C5") 2 xlindex xlindex!C5 =HYPERLINK("#'" & A2 & "'!c5",A2 & "!C5") 3 xlindex xlindex!C5 =HYPERLINK("#xlindex!c5",A3 & "!C5") 4 xlindex C5-1 =HYPERLINK("#xlindex!c5",xlindex!C5) 5 xlindex 'xlindex'!C5 =HYPERLINK("[vlookup.xls]'" & A5 & "'!C5","'" & A5 & "'!C5") 6 xlindex xlindex =HYPERLINK("file://x:/mywebsite/davemcritchie/excel/" & A6 & ".htm",A6) 7 xlindex xlindex =HYPERLINK("http://www.mvps.org/dmcritchie/excel/" & A7 & ".htm",A7)
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")
='Worksheet 1'!G3
=INDIRECT("Worksheet 1'" & "!" & "G3")
=INDIRECT("'Worksheet 1'" & "!G" & h4)
=INDIRECT("'c:\My Documents\[WTA " & Year(Now())-1 & ".xls]Sheet1'!$B$4")
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?)
| A | B | C | D | E | F | G | |
| 1 | 'h:\ | excel2k\ | [vlookup.xls] | sheet13 | '!c4 | Example | 'h:\excel2k\[vlookup.xls]sheet13'!c4 |
| 2 | h: | excel2k | vlookup.xls | sheet13 | C4 | Example | '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:\ | a2 | h: |
| b1 | excel2k\ | b2 | excel2k |
| c1 | [vlookup.xls] | c2 | vlookup.xls |
| d1 | sheet13 | d2 | sheet13 |
| e1 | '!c4 | e2 | C4 |
| f1 | =INDIRECT(A1&B1&C1&D1&E1) | f2 | =INDIRECT("'" & A2 & "\" &B2 & "\[" &C2 & "]" &D2& "'!" &E2) |
| g1 | =A1&B1&C1&D1&E1 | g2 | ="'" & A2 & "\" &B2 & "\[" &C2 & "]" &D2& "'!" &E2 |
| f1= | Example | f2= | Example |
| g1= | 'h:\excel2k\[vlookup.xls]sheet13'!c4 | g2= | 'h:\excel2k\[vlookup.xls]sheet13'!C4 |
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)
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")
| Display | Formula |
| $$ 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") |
For Each cell In Range("A1", Range("a1").End(xlDown))
Workbooks.Open (cell & ".xls")
Next
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
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
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
Q211481 - XL2000: Startup Switches for Microsoft Excel 2000
http://support.microsoft.com/support/kb/articles/Q211/4/81.ASP
Q159474 - XL97: Startup Switches for Microsoft Excel 97
http://support.microsoft.com/support/kb/articles/Q159/4/74.asp
'Clear the clipboard
Application.CutCopyMode = False
Build Table of Contents (BuildTOC) primarily deals with documentation things.
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 mailto:DMcRitchie@msn.com.