Is there a way to detect when a user
renames, or
deletes a worksheet?
I want to run some code if one of these events happens.
what I have tried
My tool uses a lot of event handlers so one thing I thought of was looping through all the sheetnames during each Worksheet_Change, but I don't think that is the best approach.
This approach goes under the ThisWorkbook module.
Public shArray1 As Variant
Public shArray2 As Variant
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Dim lngCnt As Long
Dim strMsg As String
Dim strSht
Dim vErr
Dim strOut As String
'get all sheet names efficiently in a 1D array
ActiveWorkbook.Names.Add "shtNames", "=RIGHT(GET.WORKBOOK(1),LEN(GET.WORKBOOK(1))-FIND(""]"",GET.WORKBOOK(1)))"
shArray2 = Application.Transpose([INDEX(shtNames,)])
strSht = Application.Transpose(Application.Index(shArray2, , 1))
'exit here if first time code is run
If IsEmpty(shArray1) Then
shArray1 = shArray2
Exit Sub
End If
`check each sheet name still exists as is
For lngCnt = 1 To UBound(shArray1)
vErr = Application.Match(shArray1(lngCnt, 1), strSht, 0)
If IsError(vErr) Then
strOut = strOut & shArray1(lngCnt, 1) & vbNewLine
vErr = Empty
End If
Next
shArray1 = Application.Transpose([INDEX(shtNames,)])
If Len(strOut) > 0 Then MsgBox strOut, vbCritical, "These sheets are gone or renamed"
End Sub
Related
The following code works:
Dim shts As Sheets
Set shts = Sheets(Array("Sheet1", "Sheet2"))
What I would like to do is add sheets that may be created in the future to the shts collection. The way I thought this would be accomplished involves using a loop where the sheet names are joined in a large string, making sure to obey the same formatting as in the example above. This is my non-working code:
Dim shts As Sheets
Dim wks() As Worksheet
Dim str As String
ReDim wks(0 To Sheets.Count)
Set wks(0) = Sheets(1)
str = wks(0).Name & """"
For i = 1 To UBound(wks)
Set wks(i) = Sheets(i)
str = str & ", """ & wks(i).Name & ""
Next i
Set shtsToProtect = Sheets(Array(str)) ' ERROR
[Run-time error '9': Subscript out of range]
I've tried several variants of the string argument, still no luck.
You can collect the subset sheets name into a string separated by given delimiter and then use Split() function to get an array out of it
Sub Test()
With ThisWorkbook
Dim shSubSetNames As String
Dim sh As Worksheet
For Each sh In .Worksheets
If sh.Name Like "Sheet*" Then ' change criteria as per your needs
shSubSetNames = shSubSetNames & sh.Name & "|"
End If
Next
If shSubSetNames <> vbNullString Then
shSubSetNames = Left$(shSubSetNames, Len(shSubSetNames) - 1)
Dim subSetShts As Sheets
Set shts = Sheets(Split(shSubSetNames, "|"))
shts.Select
End If
End With
End Sub
This is a solution to directly get to your goal, based on the code you wrote so far. You probably need to realize that having an array of worksheet names is not the same as only a string of names separated by commas. The latter is still just a string, not an array.
Sub Foo()
Dim i As Long
Dim shts() As String
ReDim shts(1 To ThisWorkbook.Worksheets.Count)
For i = 1 To ThisWorkbook.Worksheets.Count
shts(i) = ThisWorkbook.Worksheets(i).Name
Next i
Worksheets(shts).Select
End Sub
But as noted in the comments, there is something much simpler you can do:
Sub Bar()
ActiveWorkbook.Worksheets.Select
End Sub
I am trying to create a subroutine that will take a collection of a bunch of strings, step through it, and check for the existence of a named range or formula that has that string as it's name. Trying it with just one item first:
Dim colCritNames As New Collection
colCritNames.Add "Version" 'the name of a named formula
For i = 1 To colCritNames.Count
nm = CStr(colCritNames(i).Name)
nmchk = Check_UW_For_Name(nm)
If Not nmchk Then Call Fail("Critical Name") 'prints a msgbox with the error type so I know what happened
Next i
'...code for if all the names are there...
Function Check_UW_For_Name(find_name As String) As Boolean
Dim wb As Workbook
Set wb = UserFileBook 'global ref to the workbook to check
On Error Goto Fail
Check_UW_For_Name = CBool(Len(wb.Names(find_name).Name) <> 0)
On Error GoTo 0
End Function
Thats edited from the full thing. Check_UW_For_Name was working fine when I just called it with "Version" as the argument Check_UW_For_Name("Version"); it found it in USerFIleBook, and when I called it with "Nope", since there is no Nope name it went to my error handler. But when I try to use a collection to store the names I want to look for I keep getting 'ByRef argument mismatch'. I tried just nm = colCritNames(i) and nm=colCritNames(i).Name, I tried having find_name be Variant and adding a ByVal, and I originally tried having nm be a Name, having Check_UW_For_Name(find_name as Name) and using a for each (for each nm in colCritNames...) and none of it has worked.
How could I set a collection of names and step through it to see if there's a named range/formula that matches in the relevant workbook? Or is there a better way to do this? (I need the collection in other places too)
I don't quite understand what your plan is with a collection, but this will add any cell with the specified string in, as well as any ranges. What you're doing once they've been identified (added to collection) is not clear to me, but hopefully this makes sense and gets you going.
Sub RunForEachString()
Const yourStrings = "foo,bar,hope,this,works"
Dim stringsAsArray() As String
stringsAsArray = Split(yourStrings, ",")
Dim i As Long
For i = LBound(stringsAsArray) To UBound(stringsAsArray)
Call findAllNamesFormulas(stringsAsArray(i), ThisWorkbook)
Next i
End Sub
Private Sub findAllNamesFormulas(theText As String, theWorkbook As Workbook)
Dim ws As Worksheet, n As Name, aCell As Range
Dim aCollection As New Collection
For Each ws In ThisWorkbook.Worksheets
For Each aCell In ws.UsedRange.Cells
If InStr(1, aCell.Formula, theText, vbTextCompare) > 0 Then
aCollection.Add (aCell)
End If
Next aCell
Next ws
For Each n In ThisWorkbook.Names
If InStr(1, n.Name, theText, vbTextCompare) > 0 Then
aCollection.Add (n)
End If
Next n
'not sure what you plan to do after collection?
Debug.Print aCollection.Count
End Sub
This works for me:
Sub Tester()
Dim colCritNames As New Collection, nm, wb As Workbook, msg As String
colCritNames.Add "Version"
colCritNames.Add "NotThere"
colCritNames.Add "AlsoNotThere"
Set wb = ThisWorkbook 'for example
For Each nm In colCritNames
If Not Check_UW_For_Name(wb, CStr(nm)) Then
msg = msg & vbLf & " - " & nm
End If
Next nm
If Len(msg) > 0 Then
MsgBox "One or more required names are missing:" & msg, _
vbExclamation, "Oops"
Exit Sub
End If
'proceed if OK...
End Sub
'check for a defined Name `find_name` in workbook `wb`
' prefer wb as parameter over using a Global....
Function Check_UW_For_Name(wb As Workbook, find_name As String) As Boolean
On Error Resume Next
Check_UW_For_Name = (wb.Names(find_name).Name = find_name)
End Function
You could create a collection of all named ranges in the workbook like this:
Private Sub NamedRangesDemo()
Dim NamedRanges As New Collection, NamedRange As Variant
For Each NamedRange In ThisWorkbook.Names
NamedRanges.Add NamedRange.Name
Next NamedRange
End Sub
And then compare the whatever strings you want to the NamedRanges collection.
By the way, this question is somewhat similar to yours.
I've built a userform that allows modification of a macro-generated string before it becomes part of a new spreadsheet. As written, I have one worry about how resilient it will be.
The form has a single textbox called CourseDescription into which a string value strBundleDescription is dumped:
frmDescriptionReview.CourseDescription = strBundleDescription
frmDescriptionReview.CourseDescription.MultiLine = True
frmDescriptionReview.CourseDescription.WordWrap = True
frmDescriptionReview.Show
The user can then edit the text as needed and press OK to pass the text to the spreadsheet being created.
On clicking OK, the modified string is placed in Range("B7") of the spreadsheet:
Private Sub cmdOK_Click()
Dim strValue As String
strValue = CourseDescription.Value
If strValue <> "" Then
Range("B7").Value = strValue
End If
Unload Me
End Sub
This works so far in practice, but I've had unexplained focus issues before. I am concerned that the focus might in some (unknown) circumstance shift to another open worksheet and the text will be pasted where it does not belong.
My question: Am I right to want a more defined location, or will a simple range definition like the one above be adequate? And if a more defined location is advised, is there a way to pass information like the wkbSaba and shtCourse values without making public variables?
All potential solutions I found involved some form of public variable, but on principle (rightly or wrongly) I'm trying to avoid public variables when information will only be used in one function (as in this case).
Full Code, as requested: This is the the full macro code as it stands. The call for frmDescriptionReview is about 3/4 of the way down under the comment tag "'enter base information for Bundle Description".
I'm going to try the Property call as you suggest, which is something I did not know about, and had not seen when web searching for ways to pass data to a userform. So much to learn! It certainly looks like the variables could be passed that way.
Option Explicit
Sub TransferData()
'***************************************
' TO USE THIS MACRO:
' 1. Make sure that all information for the bundle is included
' on the 'km notification plan' and 'bundle details (kbar)' tabs
' of the Reporting_KMFramework.xlsx
' 2. Select the bundle name on the 'km notification plan' tab.
' 3. Start the macro and it should create the basis of the Saba
' form
' 4. Read through the entire form, especially the bundle
' description, to be sure it is complete and accurate.
'***************************************
'establish variables
Dim iRow As Integer
Dim sTxt As String
Dim sTxt2 As String
Dim sBundleName As String
Dim sNumber As String
Dim aSplit() As String
Dim aSplit2() As String
Dim aBundleSplit() As String
Dim aNumberSplit() As String
Dim wkbFramework As Workbook
Dim wkbSaba As Workbook
Dim shtPlan As Worksheet
Dim shtCourse As Worksheet
Dim vData As Variant
Dim vBundleName As Variant
Dim lLoop As Long
'set initial values for variables
'find current row number
iRow = ActiveCell.Row
'remember locations of current data
Set wkbFramework = ActiveWorkbook
Set shtPlan = ActiveSheet
'Set rngSelect = Range("B" & iRow)
'select bundle name
vBundleName = shtPlan.Range("B" & iRow).Value
vData = vBundleName
sBundleName = shtPlan.Range("B" & iRow).Value
'find and save course names for the bundle
Sheets(2).Select
sTxt = Find_Range(vBundleName, Columns("B"), xlValues).Offset(0, 1).Value 'course names from Detail tab
sTxt2 = Find_Range(vBundleName, Columns("B"), xlValues).Offset(0, 2).Value 'course numbers from Detail tab
'open new Saba Form
Workbooks.Add Template:= _
"C:\Documents and Settings\rookek\Application Data\Microsoft\Templates\Bundle_SabaEntryForm_KM.xltm"
'remember locations of Saba form
Set wkbSaba = ActiveWorkbook
Set shtCourse = ActiveSheet
'move data into new Saba form
'paste bundle name
wkbSaba.Sheets(shtCourse.Name).Range("B5").Value = vData
'Transfer bundle number
vData = wkbFramework.Sheets(shtPlan.Name).Range("E" & iRow).Value
sNumber = vData
Dim aNumber() As String
aNumber = Split(sNumber, "-")
wkbSaba.Sheets(shtCourse.Name).Range("B6").Value = vData
'create names to use in the bundle description and (later) in naming the file
'Establish additional variables
Dim strDate As String
Dim strName1 As String
Dim strName2 As String
Dim strName3 As String
Dim strName4 As String
Dim strName5 As String
Dim aTechSplit() As String
Dim aCourse() As String
Dim iTech As Integer
'Dim iBundle As Integer
Dim iCourse As Integer
vData = wkbFramework.Sheets(shtPlan.Name).Range("L" & iRow).Value
aCourse = Split(sTxt, Chr(10))
iCourse = UBound(aCourse)
aTechSplit = Split(vData, " ")
iTech = UBound(aTechSplit)
aBundleSplit = Split(sBundleName, " ")
aNumberSplit = Split(sNumber, "-")
strName1 = aBundleSplit(0)
strName2 = aBundleSplit(1)
If UBound(aNumberSplit) > 1 Then
strName3 = aNumberSplit(UBound(aNumberSplit) - 1) & aNumberSplit(UBound(aNumberSplit))
End If
strName3 = Right(strName3, Len(strName3) - 1)
strName4 = aTechSplit(0) & " "
strName5 = aCourse(0)
For lLoop = 1 To iTech - 1
strName4 = strName4 & aTechSplit(lLoop) & " "
Next lLoop
If iCourse > 1 Then
For lLoop = 1 To iCourse - 1
strName5 = strName5 & ", " & aCourse(lLoop)
Next lLoop
strName5 = strName5 & ", and " & aCourse(iCourse)
End If
If iCourse = 1 Then
strName5 = strName5 & ", and " & aCourse(iCourse)
End If
strName5 = Replace(strName5, " Technical Differences", "")
strName5 = Replace(strName5, " Overview", "")
strName5 = Replace(strName5, " Technical Presales for ATCs", "")
strName5 = Replace(strName5, " Technical Presales for STCs", "")
strName5 = Replace(strName5, " Technical Presales", "")
'enter base information for Bundle Description
Dim strBundleDescription As String
strBundleDescription = "This Knowledge Maintenance bundle covers recent technology changes that may affect " & strName4 & "environments. Topics covered by this bundle include the enhancements and features introduced with " & strName5 & "."
'wkbSaba.Sheets(shtCourse.Name).Range("B7").Value = strBundleDescription
frmDescriptionReview.CourseDescription = strBundleDescription
frmDescriptionReview.CourseDescription.MultiLine = True
frmDescriptionReview.CourseDescription.WordWrap = True
frmDescriptionReview.Show
'transfer tech and track
wkbSaba.Sheets(shtCourse.Name).Range("B8").Value = vData
'transfer product GA date
vData = wkbFramework.Sheets(shtPlan.Name).Range("G" & iRow).Value
wkbSaba.Sheets(shtCourse.Name).Range("B9").Value = vData
'transfer bundle notification date
vData = wkbFramework.Sheets(shtPlan.Name).Range("D" & iRow).Value
wkbSaba.Sheets(shtCourse.Name).Range("B10").Value = vData
'set audience type
If aNumber(UBound(aNumber)) = "SA" Then
wkbSaba.Sheets(shtCourse.Name).Range("B11").Value = "Internal, Partner, Customer"
Else
wkbSaba.Sheets(shtCourse.Name).Range("B11").Value = "Internal, Partner"
End If
'set Education Manager
frmEducationManagerEntry.EducationManagers.MultiLine = True
frmEducationManagerEntry.EducationManagers.WordWrap = True
frmEducationManagerEntry.Show
'set EPG
wkbSaba.Sheets(shtCourse.Name).Range("B13").Value = "N/A (KM course reuse)"
'set Test information to N/A
wkbSaba.Sheets(shtCourse.Name).Range("A22:B22").Value = "N/A"
'enter course names
aSplit = Split(sTxt, Chr(10)) 'if there is more than one course, this establishes a number and location for each
If UBound(aSplit) > 4 Then
'add rows equal to the difference between ubound and 5
wkbSaba.Sheets(shtCourse.Name).Range("A21", "B" & 21 + (UBound(aSplit) - 5)).Select
Selection.EntireRow.Insert
End If
For lLoop = 0 To UBound(aSplit)
wkbSaba.Sheets(shtCourse.Name).Range("B" & 17 + lLoop).Value = aSplit(lLoop)
Next lLoop
'enter course numbers
aSplit2 = Split(sTxt2, Chr(10)) 'if there is more than one course, this establishes a number and location for each
For lLoop = 0 To UBound(aSplit2)
wkbSaba.Sheets(shtCourse.Name).Range("A" & 17 + lLoop).Value = Trim(aSplit2(lLoop))
Next lLoop
'save and close Saba form
With wkbSaba.Sheets(shtCourse.Name)
Dim SaveAsDialog As FileDialog
strDate = Date
strDate = Replace(strDate, "/", ".")
Set SaveAsDialog = Application.FileDialog(msoFileDialogSaveAs)
With SaveAsDialog
.Title = "Choose a file location and file name for your new Saba form"
.AllowMultiSelect = False
.InitialFileName = strName1 & strName2 & "_SabaEntryForm_" & strName3 & ".xlsx"
'.InitialFileName = sSavelocation & "\" & strName3 & "\" & aBundleSplit(0) & aBundleSplit(1) & "_" & strName3 & "_SabaEntryForm" & ".xlsx"
.Show
.Execute
End With
wkbSaba.Sheets(shtCourse.Name).PrintOut
wkbSaba.Close
End With
' Return focus to Plan sheet
shtPlan.Activate
End Sub
Addition of Property code fails
I tried adding code based on the property link shared in the comments, but running the code results in a Compile error: Method or data member not found. The complete userform code looks like this:
Option Explicit
Private wkbLocation As Workbook
Private shtLocation As Worksheet
Private Sub cmdCancel_Click()
Unload Me
End
End Sub
Private Sub cmdOK_Click()
Dim strValue As String
strValue = CourseDescription.Value
If strValue <> "" Then
wkbLocation.Sheets(shtLocation).Range("B7").Value = strValue
End If
Unload Me
End Sub
Property Let MyProp(wkbSaba As Workbook, shtCourse As Worksheet)
wkbLocation = wkbSaba
shtLocation = shtCourse
End Property
And the call for the userform now looks like this:
'enter base information for Bundle Description
Dim strBundleDescription As String
strBundleDescription = "This Knowledge Maintenance bundle covers recent technology changes that may affect " & strName4 & "environments. Topics covered by this bundle include the enhancements and features introduced with " & strName5 & "."
'wkbSaba.Sheets(shtCourse.Name).Range("B7").Value = strBundleDescription
Dim frmDescriptionReview As UserForm3
Set frmDescriptionReview = New UserForm3
frmDescriptionReview.MyProp = "Pass to form"
frmDescriptionReview.CourseDescription = strBundleDescription
frmDescriptionReview.CourseDescription.MultiLine = True
frmDescriptionReview.CourseDescription.WordWrap = True
frmDescriptionReview.Show
When I run the code, I get a Compile error: Method or data member not found, highlighting .MyProp. Help says this error means I misspelled the object or member name, or specified a collection index that is out of range. I checked the spelling, and MyProp is exactly how I spelled it in both locations. I don't think I'm specifying a collection am I? None are explicitly defined. What am i doing wrong?
I am concerned that the focus might in some (unknown) circumstance
shift to another open worksheet and the text will be pasted where it
does not belong.
Not really sure what you are asking. But you can further define your range variable by using:
Workbooks("Book1.xlsm").Worksheets("Sheet1").Range("B7").Value = strValue
or
Workbooks(wkbSaba).Worksheets(shtCourse).Range("B7").Value = strValue
That will ensure it goes to the right workbook and worksheet. I'm not sure why you think you need public variables?
EDIT:
UserForm Code:
Private wsSheet As Worksheet
Property Let SetWorksheet(wsSheetPass As Worksheet)
Set wsSheet = wsSheetPass
End Property
Private Sub cmdOK_Click()
Dim strValue As String
strValue = CourseDescription.Value
If strValue <> "" Then
wsSheet.Range("B7").Value = strValue
End If
Unload Me
End Sub
Calling Module:
Dim wsSheetToPass As Worksheet
Set wsSheetToPass = Workbooks(wkbSaba).Worksheets(shtCourse)
frmDescriptionReview.SetWorksheet = wsSheetToPass
As Reafidy states, creating a Property for the Userform and passing information to it would clearly be the right answer for passing variables to and from a userform.
Ideally what I want is to have the form very losely coupled with the module, and not touch the spreadsheet at all (so when appropriate I can pass information to the form from other modules, get the information returned, and place it where appropriate for the current module (which could be on an entirely different spreadsheet or in a completely different cell).
I found additional information on passing data with properties on the PeltierTech web site (http://peltiertech.com/Excel/PropertyProcedures.html) that helped me understand what Reafidy was doing so I couls start loosening the coupling between my code and my forms even more (which was my original intent for this question.
Adding the Get property allows the loose coupling I'm looking for, allowing me to both give and receive information without having to pass the spreadsheet data at all. So my call in the module now looks like this:
'review and revise Description Text
Dim DescriptionReview As New frmDescriptionReview
With DescriptionReview
.Description = strBundleDescription
.Show
strBundleDescription = .Description
End With
Unload DescriptionReview
'transfer description text
wkbSaba.Sheets(shtCourse.Name).Range("B7").Value = strBundleDescription
and the code for the UserForm itself becomes much simpler, like this:
Option Explicit
Property Let Description(ByVal TextBeingPassed As String)
Me.CourseDescription.Value = TextBeingPassed
End Property
Property Get Description() As String
Description = Me.CourseDescription.Value
End Property
Private Sub cmdOK_Click()
Me.Hide
End Sub
Private Sub cmdCancel_Click()
Unload Me
End
End Sub
I'm currently trying to trace the dependencies of a complex set of Excel spreadsheets. My ideal end goal would be a tree structure, starting with my first spreadsheet. However, I don't want to include all of the dependencies of the child spreadsheets, just the ones of the cells referenced by the original spreadsheet. For example:
In cell A1 of my first workbook:
somebook.xls!Sheet1!C2
I want to look at cell C2 in sheet 1 of somebook.xls for its (external) dependencies, and then recurse.
At the moment I'm using LinkInfo to get a list of external dependencies, searching using Find, and I'm struggling with vbscript's primitive regex capabilities to try and extract the address out of the cells I find. This is not a brilliant way of doing things.
Does anyone know if Excel will tell you which cells in an external spreadsheet are being referenced? If not, any other tools that might help?
Thanks.
This answer is based off Bill Manville's macro from many years back. The macro still works, but I broke it out into functions allowing for more flexibility and reusability. The main addition by me is the ability to find external dependencies only, and the extension to both precedents and dependents. I also added a call to a custom macro called unhideAll; this was necessary for me as dependencies were not being found in hidden worksheets.
'Module for examining depedencies to/from a sheet from/to other sheets
Option Explicit
Sub showExternalDependents()
Dim deps As Collection
Set deps = findExternalDependents(ActiveCell)
Call showDents(deps, True, "External Dependents: ")
End Sub
Sub showExternalPrecedents()
Dim precs As Collection
Set precs = findExternalPrecedents(ActiveCell)
Call showDents(precs, True, "External Precedents: ")
End Sub
'external determines whether or not to print out the absolute address including workbook & worksheet
Sub showDents(dents As Collection, external As Boolean, header As String)
Dim dent As Variant
Dim stMsg As String
stMsg = ""
For Each dent In dents
stMsg = stMsg & vbNewLine & dent.Address(external:=external)
Next dent
MsgBox header & stMsg
End Sub
Function findPrecedents(rng As Range) As Collection
Set findPrecedents = findDents(rng, True)
End Function
Function findDependents(rng As Range) As Collection
Set findDependents = findDents(rng, False)
End Function
Function findExternalPrecedents(rng As Range) As Collection
Set findExternalPrecedents = findExternalDents(rng, True)
End Function
Function findExternalDependents(rng As Range) As Collection
Set findExternalDependents = findExternalDents(rng, False)
End Function
'Gives back only the dependencies that are not on the same sheet as rng
Function findExternalDents(rng As Range, precDir As Boolean) As Collection
Dim dents As New Collection
Dim dent As Range
Dim d As Variant
Dim ws As Worksheet
Set ws = rng.Worksheet
For Each d In findDents(rng, precDir)
Set dent = d
With dent
If Not (.Worksheet.Name = ws.Name And .Worksheet.Parent.Name = ws.Parent.Name) Then _
dents.Add Item:=dent
End With
Next d
Set findExternalDents = dents
End Function
'this procedure finds the cells which are the direct precedents/dependents of the active cell
'If precDir is true, then we look for precedents, else we look for dependents
Function findDents(rng As Range, precDir As Boolean) As Collection
'Need to unhide sheets for external dependencies or the navigate arrow won't work
Call mUnhideAll
Dim rLast As Range, iLinkNum As Integer, iArrowNum As Integer
Dim dents As New Collection
Dim bNewArrow As Boolean
'Appliciation.ScreenUpdating = False
If precDir Then
ActiveCell.showPrecedents
Else
ActiveCell.ShowDependents
End If
Set rLast = rng
iArrowNum = 1
iLinkNum = 1
bNewArrow = True
Do
Do
Application.Goto rLast
On Error Resume Next
ActiveCell.NavigateArrow TowardPrecedent:=precDir, ArrowNumber:=iArrowNum, LinkNumber:=iLinkNum
If Err.Number > 0 Then Exit Do
On Error GoTo 0
If rLast.Address(external:=True) = ActiveCell.Address(external:=True) Then Exit Do
bNewArrow = False
dents.Add Item:=Selection
iLinkNum = iLinkNum + 1 ' try another link
Loop
If bNewArrow Then Exit Do
iLinkNum = 1
bNewArrow = True
iArrowNum = iArrowNum + 1 'try another arrow
Loop
rLast.Parent.ClearArrows
Application.Goto rLast
Set findDents = dents
End Function
Sub mUnhideAll()
'
' mUnhideAll Macro
'
' Unhide All
Dim ws As Worksheet
For Each ws In Worksheets
ws.Visible = True
Next
'Sheets("Sprint Schedule Worksheet").Visible = False
End Sub
Excel's built in support, as you're finding, is limited and can be extremely frustrating.
In my experience, I've found a couple of tools from http://www.aivosto.com/ to be useful; Visustin v6 is especially useful for code related auditting/processing.
Here's a simpler version of Colm Bhandal's findDents and findExternalDents. It assumes all worksheets were made visible and arrows were cleared before use.
Function findDents(rCell As Range, bPrec As Boolean) As Collection
'Return all direct precedents (bPrec=True) or dependents (bPrec=False) of rCell
Dim sAddr As String, nLink As Integer, nArrow As Integer
Const bAbs As Boolean = False, bExt As Boolean = True
Set findDents = New Collection
If bPrec Then
rCell.showPrecedents ' even if rCell has no formula
Else
rCell.showDependents
End If
On Error Resume Next ' ignore errors
sAddr = rCell.Address(bAbs, bAbs, xlA1, bExt)
nArrow = 1
Do
nLink = 1
Do
rCell.NavigateArrow bPrec, nArrow, nLink
If ActiveCell.Address(bAbs, bAbs, xlA1, bExt) = sAddr Then Exit Do
findDents.Add Selection ' possibly more than one cell
nLink = nLink + 1
Loop
If nLink = 1 Then Exit Do
nArrow = nArrow + 1
Loop
On Error GoTo 0
If bPrec Then
rCell.showPrecedents Remove:=True
Else
rCell.showDependents Remove:=True
End If
End Function
Function findExternalDents(rCell As Range, bPrec As Boolean) As Collection
'Return ...Dents that are NOT in the same workbook and worksheet as rCell
Dim rDent As Range, wsName As String, wbName As String
With rCell.Worksheet: wsName = .Name: wbName = .Parent.Name: End With
Set findExternalDents = New Collection
For Each rDent In findDents(rCell, bPrec)
If rDent.Worksheet.Name <> wsName Or rDent.Worksheet.Parent.Name <> wbName Then findExternalDents.Add Item:=rDent
Next rDent
End Function
You might want to modify this to use a SortedList instead of a Collection. In that case, change
findDents.Add Selection
to
findDents.Add Selection.Address(bAbs, bAbs, xlA1, bExt), Null
I know how to loop through all the worksheets in a workbook, and how to exit once I reach an 'end-flag' worksheet:
For Each ThisWorkSheet In Worksheets
If ThisWorkSheet.Name = "FlagEnd" Then Exit For
MsgBox "This worksheet name is: " & ThisWorkSheet.Name
Next
However I cannot get the loop to begin on a 'start-flag' worksheet (or even better on the worksheet right after the start-flag worksheet. For example the flagged start/end worksheets are in the middle of a bunch of other worksheets, so beginning or end traversing is not workable.
There could be hundreds of worksheets before that 'FlagStart' sheet, so I really need to start on the right sheet.
Tried:
Set ThisWorkSheet = Sheets("FlagNew")
and
For Each Sheets("FlagNew") In Worksheets
Ideas?
Solution:
Mathias was very close, but dendarii was that tiny step closer with the custom ending index. I actually figured out my final solution on my own, but wanted to give credit. Here was my final solution:
Private Sub CommandButtonLoopThruFlaggedSheets_Click()
' determine current bounds
Dim StartIndex, EndIndex, LoopIndex As Integer
StartIndex = Sheets("FlagNew").Index + 1
EndIndex = Sheets("FlagEnd").Index - 1
For LoopIndex = StartIndex To EndIndex
MsgBox "this worksheet is: " & Sheets(LoopIndex).Name
' code here
Next LoopIndex
End Sub
If this is not a particularly changeable workbook (i.e. worksheets are not being added and deleted all the time), you could store the names of the worksheets in a range on a hidden sheet and loop through them by name.
However, it sounds like they are stored consecutively in the workbook so, building on Mathias' solution, you could use a function to return the indices of the start and end worksheets and then loop through:
Public Function GetStartIndex() As Integer
On Error Resume Next
GetStartIndex = ThisWorkbook.Worksheets("MyStartingWorksheet").Index + 1
End Function
Public Function GetEndIndex() As Integer
On Error Resume Next
GetEndIndex = ThisWorkbook.Worksheets("MyEndingWorksheet").Index - 1
End Function
Sub LoopThrough()
Dim wks As Worksheet
Dim i As Integer
Dim iStart As Integer
Dim iEnd As Integer
iStart = GetStartIndex()
iEnd = GetEndIndex()
If iStart > 0 And iEnd > 0 And iEnd > iStart Then
For i = iStart To iEnd
Set wks = ThisWorkbook.Worksheets(i)
MsgBox wks.Name
Next i
End If
End Sub
I believe that if you use "foreach" you won't have any control over the starting sheet. For that matter, I am not even sure you are guaranteed the order in which the iteration will take place.
I think what you should do is first, get the index of the sheet you are interested in (get the sheet by name, and get its index), and then iterate using a for loop, over the indexes of the sheets starting at the flag sheet index.
[Edit: I hacked through a quick example]
Sub Iterate()
Dim book As Workbook
Dim flagIndex As Integer
Dim flagSheet As Worksheet
Set book = ActiveWorkbook
Set flagSheet = book.Worksheets("Sheet3")
flagIndex = flagSheet.Index
Dim sheetIndex As Integer
Dim currentSheet As Worksheet
For sheetIndex = flagIndex To book.Worksheets.Count
Set currentSheet = book.Worksheets(sheetIndex)
Next
End Sub
How about?
For Each ThisWorkSheet In Worksheets
If ThisWorkSheet.Name = "FlagStart" Then output = true
If ThisWorkSheet.Name = "FlagEnd" Then Exit For
If output = true Then MsgBox "This worksheet name is: " & ThisWorkSheet.Name
Next
This code might not be quite right. I'm writing it in the SO editor not VBA, but you get the idea.
Do the sheets you iterate over have a common name format?
Ex)
Sheets(0).name > "Reports"
Sheets(1).name > "Start Here"
Sheets(2).name > "emp.0001"
Sheets(3).name > "emp.0002"
Sheets(4).name > "emp.0003"
Sheets(5).name > "emp.0004"
Sheets(6).name > "End Here"
If so, in your for each loop, just do a Left(ThisWorkSheet.name, 4) = "emp" to verify if it's a sheet you want to reference.
In Excel VBA 2013 if you have the worksheets you want to update between tabs "Blankfirst" and "Blanklast" this works.
Use the code below to test it brings back your tab names and then replace your manipulating code in place of MsgBox wks.Name part.
Sub Macro2()
On Error Resume Next
GetStartIndex = ThisWorkbook.Worksheets("Blankfirst").Index + 1
On Error Resume Next
GetEndIndex = ThisWorkbook.Worksheets("Blanklast").Index - 1
Dim wks As Worksheet
Dim i As Integer
Dim iStart As Integer
Dim iEnd As Integer
iStart = GetStartIndex
iEnd = GetEndIndex
If iStart > 0 And iEnd > 0 And iEnd > iStart Then
For i = iStart To iEnd
Set wks = ThisWorkbook.Worksheets(i)
MsgBox wks.Name
Next i
End If
End Sub
Public Sub ITERATE_WORKSHEETS()
On Error Resume Next
Dim x As Long
For x = 0 To 100
MsgBox Worksheets(x).Name
Next x
On Error GoTo 0
MsgBox "all done"
End Sub