NaamVinder
Natuurlijk gebruiken we allemaal zoveel mogelijk namen voor ranges in plaats van cel referenties. Een goed gekozen naam maakt de spreadsheet leesbaarder en als de data wat opschuiven blijft de naam geldig. In de Name Manager kun je goed zien waar een naam is gedefinieerd... maar niet waar deze naam wordt gebruikt.
Onderstaande NaamVinder vindt elke globale naam, dat wil zeggen een naam waarvan Scope = Workbook. Een lokale naam (Scope = Worksheet) wordt niet aangegeven, omdat deze meestal niet zo moeilijk te vinden is. De macro gaat door alle formules en geeft aan waar de naam wordt gebruikt. Pas op: als een naam niet in een formule voorkomt kan deze natuurlijk wel in een macro worden gebruikt.
Gebruiksaanwijzing:
1) Kopieer onderstaande tekst
2) Maak een nieuwe Module aan (ALT-F11, Modules/ Insert Module)
3) Voeg de tekst in en pas wachtwoorden aan waar nodig
4) Verknoop de macro met bijvoorbeeld CTRL-n
Option Explicit
Sub NaamVinder()
'Zoekt waar in een workbook named ranges worden gebruikt
'Graag koppelen aan CTRL-n
Dim Zoek_Tab As Worksheet
Dim Zoek_Naam As String
Dim Zoek_Gebied As Range
Dim Zoek_Cel As Range
Dim Eerste_Gevonden_Adres As String
Dim Gevonden_Adressen As String
Dim Keuze As Integer
Dim Gevonden_In_Tab, Gevonden_In_Workbook As Boolean
Dim Naamvariabele As Name
Dim Beschikbare_Namen As String
Dim i As Integer
Dim Select_Cel As Range
Application.DisplayAlerts = False
ActiveWorkbook.Sheets.Add
ActiveSheet.Name = "ExcelEngineers"
Cells(1, "A") = "De volgende globale namen (dus met Scope = Workbook) zijn beschikbaar:"
Range("A:A").ColumnWidth = 30
i = 3
For Each Naamvariabele In ActiveWorkbook.Names
If NaamIsValide(Naamvariabele.Name) Then
Cells(i, "A") = Naamvariabele.Name
i = i + 1
End If
Next
Cells(3, "A").Select
Set Select_Cel = ValideerRange(Application.InputBox(Prompt:="Selecteer een cel in kolom A om de locaties" & _
vbNewLine & "te vinden waar deze naam wordt gebruikt:", Title:="Excel Engineers", _
Default:="$A$3", Type:=8))
If Not (Select_Cel Is Nothing) Then 'Geen cancel gedrukt
If Select_Cel.Columns.Count <> 1 Or Select_Cel.Rows.Count <> 1 Or Select_Cel.Column <> 1 _
Or Select_Cel.Row < 3 Or Select_Cel.Row > i - 1 Then
MsgBox "Ongeldige selectie.", , "Excel Engineers"
Else
Zoek_Naam = Select_Cel.Value
Gevonden_In_Workbook = False
For Each Zoek_Tab In ActiveWorkbook.Worksheets
Zoek_Tab.Unprotect Password:="XXX" ‘Wachtwoord indien van toepassing
Zoek_Tab.Activate
Set Zoek_Gebied = Nothing
Gevonden_Adressen = ""
Gevonden_In_Tab = False
On Error Resume Next 'Niet elegant maar als er geen formules zijn gaat het volgende statement mis
Set Zoek_Gebied = Zoek_Tab.Cells.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not Zoek_Gebied Is Nothing Then
Set Zoek_Cel = Zoek_Gebied.Find(What:=Zoek_Naam, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not Zoek_Cel Is Nothing Then
Eerste_Gevonden_Adres = Zoek_Cel.Address
Do
If Gevonden_Adressen = "" Then
Gevonden_Adressen = Zoek_Cel.Address
Gevonden_In_Tab = True
ElseIf Len(Gevonden_Adressen) > 450 Then
ElseIf Len(Gevonden_Adressen) > 442 Then
Gevonden_Adressen = Gevonden_Adressen & ", ... "
Else
Gevonden_Adressen = Gevonden_Adressen & ", " & Zoek_Cel.Address
End If
Set Zoek_Cel = Zoek_Gebied.FindNext(Zoek_Cel)
Loop While ((Not Zoek_Cel Is Nothing) And (Zoek_Cel.Address <> Eerste_Gevonden_Adres))
End If 'Zoek_Cel is valide
End If 'Zoek_Gebied is valide
If Gevonden_In_Tab Then
Gevonden_In_Workbook = True
Range(Eerste_Gevonden_Adres).Select
Keuze = vbYes
Keuze = MsgBox("De naam " & Zoek_Naam & " is gevonden op tab " & Zoek_Tab.Name & _
" op de volgende adressen: " & vbNewLine & vbNewLine & Gevonden_Adressen & vbNewLine & _
vbNewLine & "Doorgaan met zoeken op andere tabs?", vbYesNo, "Excel Engineers")
End If
Zoek_Tab.Protect Password:="XXX" ‘Wachtwoord indien van toepassing
If Keuze = vbNo Then Exit For
Next Zoek_Tab
If Not Gevonden_In_Workbook Then
MsgBox "De naam " & Zoek_Naam & " wordt niet gebruikt in dit workbook" & _
vbNewLine & "in een formule, mogelijk wel in een macro.", , "Excel Engineers"
End If
End If 'Select_Cel binnen geldige range
End If 'Select_Cel is valide
Sheets("ExcelEngineers").Delete
Application.DisplayAlerts = True
End Sub
Private Function NaamIsValide(Brontekst As String) As Boolean
'Test of een naam niet hidden en niet lokaal is
Dim i As Integer
NaamIsValide = True
If Left(Brontekst, 5) = "_xlfn" Then NaamIsValide = False
For i = 1 To Len(Brontekst)
If Mid(Brontekst, i, 1) = "!" Then NaamIsValide = False
Next i
End Function
Private Function ValideerRange(ByVal a As Variant) As Range
'Test of een geldige Range (danwel FALSE) binnenkomt voordat deze wordt afgebeeld op een Range variabele
If TypeOf a Is Range Then Set ValideerRange = a
End Function