Using a collection to check if Names exist - excel

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.

Related

In VBA, how do I dynamically assign sheets to a sheets collection

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

How to combine Workbook, Worksheet and Range variables into one Range, in Excel VBA?

Here is an example setting:
Dim wb As Workbook
Dim ws As Worksheet
Dim rn As Range
More specifically in my scenario:
The call:
Select Case CheckInDb(Range("Username"), "\..\_DataBase_\", "UserBase.xlsm", Sheets("UD_Base"), Range("UD_Base[U_ID]"))
The function header:
Function CheckInDb(What As Variant, Folder As String, FileName As String, Ws As Worksheet, Rn As Range)
I wanted to do something like this within the function (after opening the file, etc.):
(note: Wb is generated within the function)
CheckInDb = IsError(Application.Match(What,Wb.Ws.Rn, 0))
I have tried in several ways to precombine them step by step instead, but did not succeed with any
for example
set ws = wb.Sheets("RangeAdding")
would work manually, but Ws=Wb.Ws NOT. How to work around this, to achieve all 3 parts coming from variables?
Adding more information
I will post my full function to show what the real issue is. I have modded it a bit according to your suggestions, and the problem is:
The Workbook only gets opened inside the function, however if it is not open already when I write the full range in the calling it will give me an error, that it does not exist. Therefore I wanted to first ever use the range "live" inside the function, when the reference is already open.
Sub checkUser()
Select Case CheckInDb(Range("Username"), "\..\_DataBase_\", "UserBase.xlsm", Workbooks("Userbase.xlsm").Sheets("UD_Base").Range("UD_Base[U_ID]"))
Case True: Range("Status_U").Value = ("Szabad")
Case False: Range("Status_U").Value = ("Foglalt")
End Select
End Sub
Function CheckInDb(What As Variant, Folder As String, FileName As String, Rng As Range)
Dim Wb As Workbook
Dim wasOpen As Boolean
Dim File As String, Path As String
' Relative path:
Path = ThisWorkbook.Path & Folder
File = Path & FileName
On Error Resume Next
Set Wb = Workbooks(FileName)
wasOpen = True
On Error GoTo 0
If Wb Is Nothing Then
Set Wb = Workbooks.Open(File, , True) 'with settings: (File, true,true, , PW)
wasOpen = False
End If
'...
CheckInDb = IsError(Application.Match(What, Rng, 0))
'...
Select Case wasOpen
Case True
'Wb.Save
Case False
'Wb.Save
Wb.Close (False)
End Select
Set Wb = Nothing
End Function
Your rn object already knows which Worksheet object it belongs to. (You can use rn.Parent to refer to that worksheet.) And the worksheet knows which Workbook object it belongs to. (You can use rn.Parent.Parent to refer to that workbook.)
So your code should be:
CheckInDb = IsError(Application.Match(What, Rn, 0))
This means there is no need to pass the workbook and worksheet information to your function (because it is inherent in the Range you are passing), i.e.:
Select Case CheckInDb(Range("Username"), Range("UD_Base[U_ID]"))
and
Function CheckInDb(What As Variant, Rn As Range)
Based on your edit to the question, which now makes it clear that all the objects in the calling procedure don't exist when you execute the call (and therefore the call fails), you should pass the names of your workbook (as you already do), worksheet and range, i.e.:
Sub checkUser()
Select Case CheckInDb(Range("Username"), _
"\..\_DataBase_\", "UserBase.xlsm", _
"UD_Base", _
"U_ID")
Case True: Range("Status_U").Value = ("Szabad")
Case False: Range("Status_U").Value = ("Foglalt")
End Select
End Sub
Function CheckInDb(What As Variant, _
Folder As String, FileName As String, _
wsName As String,
rngName As String) As Boolean
'...
'... existing code to create wb object
'...
Dim rn As Range
Set rn = wb.Worksheets(wsName).Range(rngName)
CheckInDb = IsError(Application.Match(What, Rn, 0))

Excel VBA check if named range is set

I'm trying to determine if a named range has been set via VBA. The named range is called LoadedToken and essentially is loaded when a user clicks a particular button. I use this as proof that initialisation has taken place.
I have a function to check if this has taken place:
Function ToolIsEnabled()
' We check if the R2A add-in has been loaded by detecting the named range
If ActiveWorkbook.Names("LoadedToken") Is Nothing Then
ToolIsEnabled = False
Else
ToolIsEnabled = True
End If
End Function
and I get an application error. Of course, the VBA is incorrect. However how can I actually accomplish this?!
Sub Test()
Debug.Print IsNamedRange("Bumsti")
End Sub
Function IsNamedRange(RName As String) As Boolean
Dim N As Name
IsNamedRange = False
For Each N In ActiveWorkbook.Names
If N.Name = RName Then
IsNamedRange = True
Exit For
End If
Next
End Function
Usage in OP context could be
' ...
If IsNamedRange("LoadedToken") Then
' ...
End If
' ...
or - if a program specific Bool needs to be set
' ...
Dim IsTokenLoaded as Boolean
IsTokenLoaded = IsNamedRange("LoadedToken")
' ...
Both constructs make it pretty clear in the source code what you are aiming for.
You can achieve this by using error handling:
Function ToolIsEnabled() As Boolean
Dim rng As Range
On Error Resume Next
Set rng = ActiveWorkbook.Range("LoadedToken")
On Error GoTo 0
ToolIsEnabled = Not rng is Nothing
End Function
This will check either in ThisWorkbook or a named workbook and return TRUE/FALSE.
Sub Test()
MsgBox NamedRangeExists("SomeName")
MsgBox NamedRangeExists("SomeOtherName", Workbooks("Book1.xls"))
End Sub
Public Function NamedRangeExists(sName As String, Optional Book As Workbook) As Boolean
On Error Resume Next
If Book Is Nothing Then
Set Book = ThisWorkbook
End If
NamedRangeExists = Book.Names(sName).Index <> (Err.Number = 0)
On Error GoTo 0
End Function
Edit:
A shorter version if it's only going to look in ThisWorkbook:
Public Function NamedRangeExists(sName As String) As Boolean
On Error Resume Next
NamedRangeExists = ThisWorkbook.Names(sName).Index <> (Err.Number = 0)
On Error GoTo 0
End Function
For the activeworkbook, you could also call the old XLM NAMES() function:
Function IsNameInActiveWorkbook(sName As String) As Boolean
IsNameInActiveWorkbook = Not IsError(Application.ExecuteExcel4Macro("MATCH(""" & sName & """,NAMES(),0)"))
End Function
As per Tom's answer these 2 line should do the trick:
On Error Resume Next
Set TestRange = ActiveWorkbook.Range("LoadedToken") 'if it does **not** exist this line will be ERROR

Detect the renaming or deletion of worksheets

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

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

Resources