Searching Aliases via Similarity
A) Intro
Your Comment as of 1/22: "The issue is not that I necessarily want to call out the alias intentionally, it's an issue of forgetting what I may have named a function to begin with (ie. verifyRange
vs verifyRng
). If I knew I was calling the alias name to begin with then I wouldn't need to call the alias. But your solution does work and it was very well thought out."
Due to your example in above cited comment: As you slightly modified your initial question, I thought about an alternative solution and added it as an independant new answer:
► You could take some advantage of using a so called SoundEx
search to group procedure names based on a phonetic algorithm.
Method: A Soundex code identifies a set of similar sounding terms, names or ... ► procedure names. If you combine this with a loop through a VBIDE list of all existing procedures/functions (don't forget to set a reference) you are able to get the most likely alias(es) listed.
Example result
1/1 Project(s): "VBAProject" (D:\Excel\test.xlsm)
**Project name: "VBAProject" ** (Host Project)
++SoundEx("verifyRange")="V616"
-- Found -- Procedure/Function name(s) --------- ------------------
[Prc: Sub] verifyRng in Std Module modTest1 Line#: 2/[Body: 3]
[Prc: Sub] verifyRange in Std Module modSortDict Line#: 6/[Body: 6]
Note: This method builds a condensed alphanumeric code based on the six phonetic classifications of human speech sounds (bilabial, labiodental, dental, alveolar, velar, and glottal), removing vocals and some occurences of 'H','W' and 'Y'; the code consists of the first capitalized letter and three following digits (filled with 0
if no more consonants found) . BTW origins date back to the late 1800's used for indexing American census records.
Links
Find the word which I closest to the particular string?
http://www.creativyst.com/Doc/Articles/SoundEx1/SoundEx1.htm#JavaScriptCode
https://en.wikipedia.org/wiki/Soundex
Soundex Example
To demonstrate the soundex coding, try the following example call with identical results:
Sub testSoundEx()
Dim i As Integer
Dim a()
a = Array("verifyRange", "verifyRng", "vrfRanges")
Debug.Print "Proc name", "SoundEx Code": Debug.Print String(50, "-")
For i = LBound(a) To UBound(a)
Debug.Print a(i), SoundEx(a(i))
Next i
End Sub
SoundEx Function
Function SoundEx(ByVal s As String) As String
' Site: https://stackoverflow.com/questions/19237795/find-the-word-which-i-closest-to-the-particular-string/19239560#19239560
' Source: Developed by Richard J. Yanco
' Method: follows the Soundex rules given at http://home.utah-inter.net/kinsearch/Soundex.html
Dim Result As String, c As String * 1
Dim Location As Integer
s = UCase(s) ' use upper case
' First character must be a letter
If Len(Trim(s)) = 0 Then
Exit Function
ElseIf Asc(Left(s, 1)) < 65 Or Asc(Left(s, 1)) > 90 Then
SoundEx = ""
Exit Function
Else
' (1) Convert to Soundex: letters to their appropriate digit,
' A,E,I,O,U,Y ("slash letters") to slashes
' H,W, and everything else to zero-length string
Result = Left(s, 1)
For Location = 2 To Len(s)
Result = Result & Category(Mid(s, Location, 1))
Next Location
' (2) Remove double letters
Location = 2
Do While Location < Len(Result)
If Mid(Result, Location, 1) = Mid(Result, Location + 1, 1) Then
Result = Left(Result, Location) & Mid(Result, Location + 2)
Else
Location = Location + 1
End If
Loop
' (3) If category of 1st letter equals 2nd character, remove 2nd character
If Category(Left(Result, 1)) = Mid(Result, 2, 1) Then
Result = Left(Result, 1) & Mid(Result, 3)
End If
' (4) Remove slashes
For Location = 2 To Len(Result)
If Mid(Result, Location, 1) = "/" Then
Result = Left(Result, Location - 1) & Mid(Result, Location + 1)
End If
Next
' (5) Trim or pad with zeroes as necessary
Select Case Len(Result)
Case 4
SoundEx = Result
Case Is < 4
SoundEx = Result & String(4 - Len(Result), "0")
Case Is > 4
SoundEx = Left(Result, 4)
End Select
End If
End Function
Helper function called by SoundEx()
This helper function returns a letter code based on phonetic classifications (see notes above):
Private Function Category(c) As String
' Returns a Soundex code for a letter
Select Case True
Case c Like "[AEIOUY]"
Category = "/"
Case c Like "[BPFV]"
Category = "1"
Case c Like "[CSKGJQXZ]"
Category = "2"
Case c Like "[DT]"
Category = "3"
Case c = "L"
Category = "4"
Case c Like "[MN]"
Category = "5"
Case c = "R"
Category = "6"
Case Else 'This includes H and W, spaces, punctuation, etc.
Category = ""
End Select
End Function
► Solution to your issue - Example Call to get Functions by Alias
B) Memory issue or how to jog one's memory
You can use the following example call to search for procedure/function aliases via Syntax listProc {function name string}
, e.g. listProc "verifyRange"
and you get a condensed list of all found aliases in the Immediate Window of your Visual Basic Editor (VBE):
Sub Test()
listProc "verifyRange" ' possibly gets verifyRange AND verifyRng via SoundEx "V616"
'listProc "verify" ' possibly gets nothing, as SoundEx "V610" has no fourth consonant
'listProc '[ displays ALL procedures without SoundEx Filter ]
End Sub
Note: Keep in mind that the SoundEx Code (e.g. "V616" for verifyRange
) is limited to a length of four alphanumeric characters.
If you are looking for "verify" only (= 3 consonants V+r+f), you would get "V610" instead without findings of "verifyRange" or "verifyRng" (V+r+f+r).
In this case you should search for a pair of variants.
=============================
Main procedure listProc
=====================
Sub listProc(Optional ByVal sFuncName As String)
' Purpose: display procedures using a SoundEx Filter
' Call: 0 arguments or empty argument - ALL procedures without filter
' 1 argument (not empty) - procedures found via SoundEx
' Note: requires reference to Microsoft Visual Basic for Applications Extensibility 5.3
' Declare variables to access the macros in the workbook.
Dim VBAEditor As VBIDE.VBE ' VBE
Dim objProject As VBIDE.VBProject ' Projekt
Dim objComponent As VBIDE.VBComponent ' Modul
Dim objCode As VBIDE.CodeModule ' Codeblock des Moduls
' Declare other miscellaneous variables.
Dim sProcName As String
Dim sndx As String, sndx2 As String
Dim pk As vbext_ProcKind ' proc kind (Sub, Function, Get, Let)
Dim strPK As String, sTyp As String
Dim iLine As Integer, iBodyLine As Integer, iStartLine As Integer
Dim i As Integer
Dim bShow As Boolean ' show procedure name
Dim bSoundEx As Boolean
If Len(Trim(sFuncName)) > 0 Then bSoundEx = True ' show alle procedures!
' ========================================
' Get the project details in the workbook.
' ========================================
Set VBAEditor = Application.VBE
Set objProject = VBAEditor.ActiveVBProject
' Set objProject = VBAEditor.VBProjects("MyProcject") ' 1-based, project name or item number
For i = 1 To VBAEditor.VBProjects.Count ' show name, filename, buildfilename (DLL)
Debug.Print i & "/" & _
VBAEditor.VBProjects.Count & " Project(s): """ & _
VBAEditor.VBProjects(i).Name & """ (" & VBAEditor.VBProjects(i).filename & ")"
Next i
' get SoundEx of Function name
sndx2 = SoundEx(sFuncName)
' ==================
' ? PROJECT NAME
' ==================
' objProject.Type ...vbext_pt_HostProject 100 Host-Project
' ...vbext_pt_StandAlone 101 Standalone-Project
Debug.Print "**Project name: """ & objProject.Name & """ ** (" & _
IIf(objProject.Type = 100, "Host Project", "Standalone") & ")"
If bSoundEx Then Debug.Print "++SoundEx(""" & sFuncName & """)=""" & sndx2 & """" & _
vbNewLine & "-- Found -- Procedure/Function name(s)"
' Iterate through each component (= Module) in the project.
For Each objComponent In objProject.VBComponents ' alle MODULE
' Find the code module for the project (Codeblock in current component/=module).
Set objCode = objComponent.CodeModule
' =============
' ? MODULE NAME
' =============
If objCode.CountOfLines > 0 And Not bSoundEx Then
Debug.Print " *** " & _
sModType(objComponent.Type) & " ** " & objComponent.Name & " ** "
End If
' Scan through the code module, looking for procedures.
' Durch alle Codezeilen des jeweiligen Moduls gehen
iLine = 1
Do While iLine < objCode.CountOfLines ' alle Zeilen durchackern (1/End ...)
' =================
' Get Procedurename ' !! SETZT AUTOMATISCH >> pk << !!
' =================
sProcName = objCode.ProcOfLine(iLine, pk) ' jede nächste Zeile auf Prozedurbeginn checken
If sProcName <> "" Then ' ohne Declaration head
' -----------------
' Found a procedure
' -----------------
' a) Get its details, and ...
strPK = pk ' 0-Prc|1-Let/2-Set/3-Get Werte abfangen !!!
'' iStartLine = objCode.ProcStartLine(sProcName, strPK) ' here = iLine !!
iBodyLine = objCode.ProcBodyLine(sProcName, strPK) ' Zeilennr mit Sub/Function/L/S/Get
sTyp = sPrcType(objCode.Lines(iBodyLine, 1)) ' Sub|Fct|Prp
' b) Check Soundex
If bSoundEx Then
sndx = SoundEx(sProcName)
If sndx = sndx2 Or UCase(sProcName) = UCase(sFuncName) Then
bShow = True
Else
bShow = False
End If
Else
bShow = True
End If
' ==============
' c) ? PROC NAME
' --------------
If bShow Then
Debug.Print " " & "[" & sPK(strPK) & ": " & sTyp & "] " & _
sProcName & IIf(bSoundEx, " in " & sModType(objComponent.Type) & " " & objComponent.Name, "") & vbTab, _
"Line#: " & iLine & "/[Body: " & iBodyLine & "]"
End If
' -------------------------------------------
' d) Skip to the end of the procedure !
' => Add line count to current line number
' -------------------------------------------
iLine = iLine + objCode.ProcCountLines(sProcName, pk)
Else
' This line has no procedure, so => go to the next line.
iLine = iLine + 1
End If
Loop
Next objComponent
' Clean up and exit.
Set objCode = Nothing
Set objComponent = Nothing
Set objProject = Nothing
End Sub
3 Helper Functions to the Main procedure listProc
These helper functions return additional information to procedures and module:
Function sPK(ByVal prockind As Long) As String
' Purpose: returns short description of procedure kind (cf ProcOfLine arguments)
Dim a(): a = Array("Prc", "Let", "Set", "Get")
sPK = a(prockind)
End Function
Function sPrcType(ByVal sLine As String) As String
' Purpose: returns procedure type abbreviation
If InStr(sLine, "Sub ") > 0 Then
sPrcType = "Sub" ' sub
ElseIf InStr(sLine, "Function ") > 0 Then
sPrcType = "Fct" ' function
Else
sPrcType = "Prp" ' property (Let/Set/Get)
End If
End Function
Function sModType(ByVal moduletype As Integer) As String
' Purpose: returns abbreviated module type description
Select Case moduletype
Case 100
sModType = "Tab Module"
Case 1
sModType = "Std Module"
Case 2
sModType = "CLS Module"
Case 3
sModType = "Frm Module"
Case Else
sModType = "?"
End Select
End Function