VBA Excel - Finding where all names are used in Workbook - excel

I'm looking for some VBA code or reference that is able to locate all places in a workbook (or possibly outside, but that is not a normal use for me). I'm using Excel 2010 (for now).
I am recording the full list of names, their sources, formulas, and where they are used. I have the first several from the names class, but the "where they are used" method is time consuming, even when turning off Excel update actions.
I have seen multiple references to this code (below) in various sites but this is a time consuming method. (I reference certain names in large amounts, like the thousands).
Code below from: https://excelhelphq.com/how-to-find-all-dependent-cells-outside-of-worksheet-and-workbook-in-excel-vba/
Sub messageBoxCellDependents()
Dim SelRange As Range
Set SelRange = Selection
MsgBox findDepend(SelRange) 'show user dependent cells in a pop up message box
End Sub
Function fullAddress(inCell As Range) As String
fullAddress = inCell.Address(External:=True)
End Function
Function findDepend(ByVal inRange As Range) As String
Dim sheetIdx As Integer
sheetIdx = Sheets(inRange.Parent.Name).Index
If sheetIdx = Worksheets.Count Then 'vba bug workaround
Sheets(sheetIdx - 1).Activate
Else
Sheets(Worksheets.Count).Activate
End If
Dim inAddress As String, returnSelection As Range
Dim i As Long, pCount As Long, qCount As Long
Set returnSelection = Selection
inAddress = fullAddress(inRange)
Application.ScreenUpdating = False
With inRange
.ShowPrecedents
.ShowDependents
.NavigateArrow False, 1
Do Until fullAddress(ActiveCell) = inAddress
pCount = pCount + 1
.NavigateArrow False, pCount
If ActiveSheet.Name <> returnSelection.Parent.Name Then
Do
qCount = qCount + 1
.NavigateArrow False, pCount, qCount
findDepend = findDepend & fullAddress(Selection) & Chr(13)
On Error Resume Next
.NavigateArrow False, pCount, qCount + 1
Loop Until Err.Number <> 0
.NavigateArrow False, pCount + 1
Else
findDepend = findDepend & fullAddress(Selection) & Chr(13)
.NavigateArrow False, pCount + 1
End If
Loop
.Parent.ClearArrows
End With
With returnSelection
.Parent.Activate
.Select
End With
Sheets(sheetIdx).Activate 'activate original worksheet
End Function
However, when using the "Trace Dependents" feature in the Ribbon, the arrows and references produced take only as long as it takes for the arrows (when in sheet) to render on screen, which appears to me like there is a recorded list of where items are used (at least within a workbook).
Does this list actually exist? Is there a way to get to it? There should be a faster method, in theory.

Related

SOLVED - ]Read data and copy to current workbook

With below code, no errors are displayed, the read file opens but it seems not data is copied.
I am trying to copy only a number of columns, but it seems nothing is been copied to current workbook.
Any help would be appreciated as I am very new with VBA
Sub ReadDataFromCloseFile()
On Error GoTo ErrHandler
'stop screen update
Application.ScreenUpdating = False
Dim src As Workbook
Dim sTheSourceFile As String
sTheSourceFile = "C:\Users\grmn\Desktop\testreadfile.xlsx"
Set src = Workbooks.Open(sTheSourceFile, True, True)
Dim iRowsCount As Long
'source of data
With src.Worksheets("Sheet1")
iRowsCount = .Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Rows.Count
End With
Dim iCnt As Long
'destination sheet thisWorkbook.sheet("rapport")
For iCnt = 1 To iRowsCount
Worksheets("rapport").Range("A" & iCnt).Formula = src.Worksheets("Sheet1").Range("A" & iCnt).Formula
Worksheets("rapport").Range("F" & iCnt).Formula = src.Worksheets("Sheet1").Range("B" & iCnt).Formula
Next iCnt
'close but not overide source file (src).
src.Close False
Set src = Nothing
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
No worries being new, we all were at some point.
The first part of your code 'source of data doesn't work as intended. iRowsCount is an Integer and not an Array. To make use of an array, as you seemingly tried to do, you should use
Dim iRowsCount(8) As Long
With src.Worksheets("Sheet")
iRowsCount(1) = .Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Rows.Count
' ...
End With
' ...
If you use an Integer only the last row will be assigned. So if "AT", for some reason, has 5 rows, iRowsCount will be 5. Nothing else. Not accounting for "AQ" or "AS".
But in your case, Integer/Long would probably suffice if all rows have the exact same count. One assignment would be enough then.
Regarding .Formula - are you really trying to write formulas? Have you tried .value instead?
And, what may be the crux of the matter, try Worksheets("rapport").Save or Worksheets("rapport").SaveAs at the end of your function.
(Haven't tested it on my end so far.)
Additionally, please remember to set Exit Sub (or Exit Function respectively, if a Function) to avoid executing ErrHandler if no error occurs.
(Sorry, I'm new to Stackoverflow, so I can't write comments as of yet.)
(Edit: Thanks for the reminder, #FunThomas, Integer is only -32768 to 32767. Long is 8 bytes.)

Assigning Macro with ParamArray: Formula is Too Complex to add to the Object

I have a macro (below) that inserts a new row into an un-defined number of Named ranges using ParamArray, it works fine except for when I try to assign the macro with more than 5-6 arguments I get a message box that says "Formula Too Complex to Assign To Object" (see picture above)
(see assignment string below)
'InsertNewRow "ServiceCrewDay_EmployeeList", "SAP_SCD_InPool", "SAP_SCD_OutPool", "SAP_SCD_SecondaryIn", "SAP_SCD_SecondaryOut", "SAP_SCD_ORD","SAP_SCD_THF","SAP_SCD_LH", "SAP_SCD_LH"'
Macro:
Sub InsertNewRow(ParamArray args() As Variant)
Dim ans: ans = MsgBox("WARNING: " & vbNewLine _
& "Action Cannot be undone!" & vbNewLine & "Continue?", vbYesNo, "Warning!")
If ans = vbNo Then: Exit Sub
Call HaltOperations
Call ActiveSheet.Unprotect()
Call Sheets("SAP Timesheet").Unprotect()
On Error GoTo OnError_Exit
'Loop and Check All Named Ranges Exist Before Proceeding
For Each a In args
If RangeExists(a) = False Then
MsgBox ("Named Range: " & a & " Not Defined!" & vbNewLine & "Operation Cancelled")
Exit Sub
End If
Next a
Dim rng As Range
'ADD ROW TO EACH NAMED INPUT RANGE
For Each a In args
Set rng = Range(a)
With rng
.Rows(.Rows.count).EntireRow.Insert
.Rows(.Rows.count - 2).EntireRow.Copy
.Rows(.Rows.count - 1).EntireRow.PasteSpecial (xlPasteFormulasAndNumberFormats)
On Error Resume Next: .Rows(.Rows.count - 1).EntireRow.PasteSpecial (xlPasteFormats)
End With
Next a
On Error GoTo OnError_Exit
'ADJUST HEIRACHY NUMBERS ON FIRST INPUT RANGE (MANNING TAB)
Set rng = Range(args(0))
Dim col As Integer
col = rng.Column
Cells(rng.Row + rng.Rows.count - 2, col).Offset(0, -1).Value _
= Cells(rng.Row + rng.Rows.count - 3, col).Offset(0, -1).Value + 1
Cells(rng.Row + rng.Rows.count - 1, col).Offset(0, -1).Value _
= Cells(rng.Row + rng.Rows.count - 3, col).Offset(0, -1).Value + 2
Call ResumeOperations
Application.CutCopyMode = False
Call ActiveSheet.Protect()
Call Sheets("SAP Timesheet").Protect()
Exit Sub
OnError_Exit:
Call ResumeOperations
Application.CutCopyMode = False
Call ActiveSheet.Protect()
Call Sheets("SAP Timesheet").Protect()
End Sub
Private Function RangeExists(rng As Variant) As Boolean
Dim Test As Range
On Error Resume Next
Set Test = Range(rng)
RangeExists = Err.Number = 0
End Function
Private Sub HaltOperations()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
End Sub
Private Sub ResumeOperations()
ResumeOps:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
The Macro itself runs as expected it's just the assigning the named ranges that is causing the issue.
is there a better way to do this?
or is there a way to get around the Formula is too complex method?
and if there is will that need to be done on all end user pc's or just on mine and the settings will carry over?
What I have thought about doing was just taking in 2 Named ranges and then for the following ranges Just offsetting those by the Row Count of the previous range so if Range2 = Sheets().Range("A1:A10") then Range3 = Range2.Offset(Range2.Rows.Count,0) then the assingment input would only need to be Range1 as string, Range2 as string, NumberOfExtraRanges as integer the reason I need atleast two ranges is because every range after range 1 is on a different tab and is essentially a raw data version of all pay info hours etc. in the first tab which will be Range1_EmployeeList
which I will play around with while I wait for a response.
TIA
Not a Complete answer but I did find that inside the ParamArray I could just assign One Input Range using a , to seperate each defined range. I haven't tested the limitations doing it this way but it does seem to atleast let me use a few extra inputs.
Example (Not Working):
Note: Each Defined Range is a Separate Input
'InsertNewRow "ServiceCrewDay_EmployeeList", "SAP_SCD_InPool" ," SAP_SCD_OutPool","SAP_SCD_SecondaryIn", "SAP_SCD_SecondaryOut"'
Example (Working):
Note Each Defined Range is passed as 1 input
'InsertNewRow "ServiceCrewDay_EmployeeList", "SAP_SCD_InPool, SAP_SCD_OutPool,SAP_SCD_SecondaryIn,SAP_SCD_SecondaryOut"'

VBA Macro Stops/Hangs Excel after about 4000 Iterations

I am posting this on behalf of someone else. Hoping I learn something in the process.
One of my team members is working on an excel macro that loops through the rows in a spreadsheet that contains over 14,000 rows. With each loop, it moves relevant data into a new tab within the workbook. The loop completes successfully unless we use the LastRow variable, or if we tell it to go for more than 400-4500 rows, then it crashes or hangs without any useful error info. The behavior does not change on different machines. We are using Excel 2016 to run the macro. I wanted to share the code with you to see if there is something that is causing it to hang (But why would it work fine for up to 4000 rows, and then quit beyond? I suspect memory issues to be the cause...)
I am sorry if this is answered elsewhere, I am not experienced enough to recognize if certain suggestions apply to this particular code.
Here is the code:
Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set sht = wb.Sheets(shtName)
On Error GoTo 0
SheetExists = Not sht Is Nothing
End Function
Sub SortProductionIntoWorkcenters()
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
LastRow = Worksheets("TL Production").Cells.SpecialCells(Type:=XlCellType.xlCellTypeLastCell).Row
FirstRow = 3
Dim rng As Range, cel As Range
'The next line that says Cells(LastRow, 4)) is where I can change how may iterations the loop will process
Set rng = Worksheets("TL Production").Range(Cells(FirstRow, 4), Cells(LastRow, 4))
Dim SheetName As String
Dim r As Integer
r = 2
For Each cel In rng
Worksheets("TL Production").Select
If Cells(cel.Row, cel.Column) = "" Then
Cells(cel.Row, cel.Column) = "EMPTY"
End If
SheetName = Worksheets("TL Production").Cells(cel.Row, 4).Value
SheetName = Replace(SheetName, "/", " ")
If Not SheetExists(SheetName) Then
Worksheets.Add.Name = SheetName
End If
Worksheets("TL Production").Rows(cel.Row).Cut
Do While r > 0
If IsEmpty(Worksheets(SheetName).Cells(r, 1)) Then
Worksheets(SheetName).Rows(r).Insert shift:=xlDown
r = 2
Exit Do
End If
r = r + 1
Loop
Next cel
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
'MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
' MsgBox "This code ran successfully in " & MinutesElapsed & " minutes", vbInformation
End Sub
Not an answer, but you would really benefit from simplifying your code. Eg:
For Each cel In rng
Worksheets("TL Production").Select
If cel = "" Then
cel = "EMPTY"
End If
SheetName = cel
etc...
Although I'm not entirely sure what the real issue in your code is (could very well be memory related), I see a couple of things that can improve your code, as well as its performance. See the bottom of the post for my proposal of a revised version of your code.
For Each cel In rng
Worksheets("TL Production").Select
If Cells(cel.Row, cel.Column) = "" Then
Cells(cel.Row, cel.Column) = "EMPTY"
End If
Executing .Select every single loop slows down your code drastically, as each .rows(r).Insert seems to change to another sheet. So your code forces Excel to constantly switch Worksheets. Redrawing the screen is orders of magnitude slower than performing calculations or reading some values from the sheet.
This can be further mitigated by completely switching off screen updating:
Application.ScreenUpdating = False
ws.Select
For Each cel In rng.Cells
...
Next cel
Application.ScreenUpdating = True
As mentioned by #PatrickHonorez, Cells(cel.Row, cel.Column) is a little bit overdoing it. It's a more complicated way of referencing cel - so why not use that directly? :) It also has the pitfall of not necessarily returning the correct cell, due to not being fully referenced. (Cells actually means ActiveWorkbook.ActiveSheet.Cells, so if your Workbook/Sheet change due to whatever reason, your script suddenly runs into trouble.)
If cel.Value = "" Then
cel.Value = "EMPTY"
End If
As mentioned in a comment by #dwirony, the While r > 0 condition in the Do Loop isn't really doing anything. There is no path through your code that allows for r < 2. Also, the way this loop is constructed is the major contributor to the macro's slow execution. (Several thousand rows in the original sheet means we enter this particular loop the equally often, and each time it has to count a little higher, due to the target sheets growing.)
I think this would be a good place to use a dictionary to store the number of the last row you inserted:
Do While r > 0
DoEvents
If IsEmpty(Worksheets(SheetName).Cells(r, 1)) Then
Worksheets(SheetName).Rows(r).Insert shift:=xlDown
dict(SheetName) = r
Exit Do
End If
r = r + 1
Loop
Generally:
Use Option Explicit at the top of any module. It will make your life easier. (Thus the compiler will force you to declare each and every variable you use. This makes your code more concise and eliminates potential typos, among other benefits.) You can also make this the standard in the VBA IDE's options.
If the sheets modified by your macro contain formulas you can deactivate automatic recalculation (if not already set to manual) with Application.Calculation = xlCalculationManual - this will in some cases further reduce execution times. If you want to set it back to automatic afterwards, use Application.Calculation = xlCalculationAutomatic.
Add a line DoEvents to each and every Do Loop you don't perfectly trust. This will allow you stop/pause the macro if it turns out to be an (almost) infinite loop.
My revised version, I tested it with about 6000 rows to be distributed to 3 different worksheets. It took about 2min to complete. Although rows with more data might take longer than my quick mock-up.
Sub SortProductionIntoWorkcenters()
Dim StartTime As Double
Dim SecondsElapsed As Double
Dim LastRow As Long, FirstRow As Long
Dim Ws As Worksheet
Dim Dict As Scripting.Dictionary
StartTime = Timer
Set Dict = New Scripting.Dictionary
Set Ws = Worksheets("TL Production") ' Set the reference to the starting sheet once and then use that
LastRow = Ws.Cells.SpecialCells(Type:=XlCellType.xlCellTypeLastCell).Row
FirstRow = 3
Dim rng As Range, cel As Range
'The next line that says Cells(LastRow, 4)) is where I can change how may iterations the loop will process
Set rng = Ws.Range(Cells(FirstRow, 4), Cells(LastRow, 4))
Dim SheetName As String
Dim r As Long ' Use Long datatype here to prevent integer overflow
r = 2
Application.ScreenUpdating = False
For Each cel In rng.Cells ' make explicit that we are iterating over all cells in range
If cel.Value = "" Then
cel.Value = "EMPTY"
End If
SheetName = Ws.Cells(cel.Row, 4).Value
SheetName = Replace(SheetName, "/", " ")
If Not SheetExists(SheetName) Then
Worksheets.Add.Name = SheetName
End If
Ws.Rows(cel.Row).Cut
If Dict.Exists(SheetName) Then r = Dict(SheetName)
Do
DoEvents
If IsEmpty(Worksheets(SheetName).Cells(r, 1)) Then
Worksheets(SheetName).Rows(r).Insert shift:=xlDown
Dict(SheetName) = r + 1 ' Add one, as the row r is not empty by defition
Exit Do
End If
r = r + 1
Loop
Next cel
Application.ScreenUpdating = True
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
'MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
' MsgBox "This code ran successfully in " & MinutesElapsed & " minutes", vbInformation
End Sub

Tracing precedents in external spreadsheets using Excel VBA

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

How can I loop through a subset of worksheets?

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

Resources