Visual Basic for Applications/Redundant Variables List

Summary This very long code module lists an Excel project's redundant variables. Running the top procedure checks the VBA project of ThisWorkbook, that is, the workbook in which the code is run. It produces both worksheet and user form outputs. The code is self-contained in the one module, but in addition, the user needs to make a user form called ViewVars, with a textbox in it called TextBox1. The details are not too important since the display is adjusted in code to fit the contents. However, the user form's property ShowModal should be set to False, and Multiline set to True. A testing mode of sorts can be had by setting boolean variable bUseWorkSheets in RunVarChecks to True. Be advised however, that this will clear all existing worksheets before writing to sheets one to five. To labor the point, if your intention is to not disturb the contents of project sheets one to five, then be sure that bUseWorkSheets of RunVarChecks is set to False; redundant variables will still be listed in the user form ViewVars after a few seconds of code run. Points to Note There are some limitations: The listing can only work for code that compiles correctly; that is, sensible constructs if not necessarily working code. API variable declarations and enumerations of constants are not handled. That is to say, they will not be listed even if they are redundant. The module is coded to work with the VBAProject of ThisWorkbook . There is however, an optional parameter to access another workbook object for those who intend to check some other. The module works with the usual VBA variable naming methods. This includes the use of public same-names, and fully expressed variable descriptions. It does so by searching for compound similars as well as their simple forms. For example, although rare, the three forms myvar, Module1.myvar, and VBProject.Module1.myvar could all be used in code for the same variable. The use of these forms allows the same variable names to be used in any module heading without conflict. Several worksheet listings are made for output results and testing. The user should make sure that sheets 1 to 5 exist, since the code will not create them in this listing. The user might want to restrict or change these in the main procedure if they will conflict with other uses. A separate user form output makes use of procedure AutoLayout. The user form styles might not suit everyone, but the colorings and fonts can be changed in two user-sections of the procedure AutoLayout. Bear in mind however, that the chosen font must be monospaced for a neat layout. Apart from this restriction, the layout will handle any regular font size from about 6 to 20 points, as well as the bold and italic variants. That is to say, the code will auto-adjust the userform layout and sizes to produce a useful display. Procedures have not been marked as module Private. There is the remote possibility of same-name procedures being encountered when users also make use of other modules in this series. In future I will try to remember to mark them module-private if they look as though they were used elsewhere. Interested parties might like to advise of any bugs. Please use only the Discussion page and I will get to them as soon as I can. Work Method Used General Preparation The general method is to make a declared variables list then test each variable entry to see if it is used. The project string contains all of the code in the project. The string is loaded into a work array line by line, and is passed in variants from process to process. Procedure, module, and project name information is also added. Every code line is marked with this information. Quotes and comments are removed, since they could contain any text at all, and might confuse the decision process. Other confusions arise from continuation lines, so these are all joined up into single long lines prior to interpretation. Shared label lines and line numbers can also cause difficulty, so labels are given lines of their own, and line numbers are separated prior to any decision process. Blank lines are not needed so they are removed. Because there is a changed line count, the project work array is renumbered. Each code line is marked with its residential line ranges. Each line is given the code line range for the procedure and for the module in which it resides. This data is then easily found later. The Declared Variables The declared variables list, the array vDec, contains every declared variable in the project. It lists all other pertinent data about each variable. The scope of each variable is determined and added. The nominal search line ranges are also added. These are the line ranges suggested at first sight after knowing the scope of the variable. For example, a procedure level declaration would show the procedure line range, and a module-private item the module's line range. The variables are marked on vDec when they are found as used. The search sequence is, all of the procedure level variables, then the module private variables, then lastly the public variables. When there are same-name variables with different scopes, this sequence is useful, in that it progressively reduces the required search ranges. Every variable is checked for naming ambiguity before deciding which search method to use. Only if there is no names ambiguity can a so-called normal approach be taken; ie; searching the entire nominal line range. Otherwise, the nominal search range needs modified to avoid regions where same-name variables were already found. For example, a module variable search would not look in a procedure where a same-named variable had been both declared and used, but would check anyway if no same-name item were declared there. Public and module level variables have to be checked in three names. Variables' full names can include project, module, and variable names, or just module and variable names, in addition to the better known short forms. Public variables are handled a bit differently. These variables can exist in each module with the same name. There are two kinds of duplicated names possible for public variables; firstly, there is the kind where there is a public variable with the same name as a variable in any number of procedures, and secondly, there is the kind where the same name is used for a public variable in more than one module heading. In these same-name cases the use of public variables need at least the module and variable name when their use is not in the module where declared. Most of the time a public variable's name is entirely unique. That is, there is no other variable in the project with the same name. In this case the use of the variable can be searched throughout the project without restriction. If the public variable has no same-names in other module heads, but there are same-names in module or procedure variables, then the whole project must be searched for its use, taking into account line restrictions from modules and procedures where such same-names were already found as used. If the public variable has same-name variables in more than one module heading, then the determination of variable use must be handled in two stages; The entire project must be searched without restriction using both compound forms of the public variable Then search in the module where the public variable is declared, taking account of any procedure restrictions that apply from same-names there. After all this, any variables not marked as used can be listed as redundant. VBA Code Module Updated and Tested 17 Sep 2017 Modified changed word aliases to similars (15 Jan 2018). Modified AutoLayout() to avoid wrap back in form. Label length plus 4 spaces now, not 2. (17 Sep 2017). Added a note on need for VBA Extensibility 5.3 and tested code - working OK.(31 Dec 2016) Modified AutoLayout() to reduce control count.(17 Nov 2016). Modified AutoLayout() for better font choice.(16 Nov 2016). Added simpler options for fonts in AutoLayout().(16 Nov 2016) Modified code in dynamic arrays and added test mode switch bUseWorkSheets in RunVarChecks().(15 Nov 2016) Removed one redundant procedure and corrected TrimStr error.(13 Nov 2016) Corrected code call to NewPubRange() in MarkPubVarUse(). Parameter lines now whole project.(8 Nov 2016) Changes made to user form display procedures. (7 Nov 2016) Option Explicit Option Base 1 Sub TestVars() 'Be sure to set a reference to Visual Basic for Applications Extensibility 5.3 Dim vWB As Variant 'set reference to a workbook 'in the current workbooks collection Set vWB = ThisWorkbook RunVarChecks vWB End Sub Sub RunVarChecks(Optional vWB As Variant) 'runs a redundant variable check on a workbook's code project 'If no workbook supplied in vWB defaults to this workbook. 'Exclusions: "Declared", "Type" and "Const" declarations. 'CLEARS ALL WORKSHEETS AND REWRITES TO SHEETS 1 TO 5 'WHEN bUseWorkSheets IS TRUE Dim sht As Worksheet, vDec As Variant, vX As Variant, vAB As Variant Dim c As Long, n As Long, UDec2 As Long, sLN As Long, vT As Variant Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long Dim vJ As Variant, vK As Variant, vL As Variant, vM As Variant Dim vP As Variant, vR As Variant, vS As Variant, vN As Variant Dim vU As Variant, vV As Variant, vW As Variant, vDisp As Variant Dim sLS As String, sPN As String, sMN As String, sProc As String Dim sVScope As String, sP As String, bOneToFind As Boolean Dim bProcNamed As Boolean, bNotFirst As Boolean, Upper As Long Dim bUseWorkSheets As Boolean Dim Uform As UserForm '================================================================== bUseWorkSheets = False 'when true, overwrites all worksheets ' and displays test data in sheets 1 to 5, ' else when false, userform output only. '================================================================== 'decide whether to use parameter wb or this one If IsMissing(vWB) Then Set vWB = ThisWorkbook End If 'clear sheets - clears all sheets 'and unloads open userforms For Each Uform In VBA.UserForms Unload Uform Exit For Next Uform If bUseWorkSheets = True Then For Each sht In ThisWorkbook.Worksheets sht.Activate sht.Range("A1:Z65536").ClearContents Next sht End If 'PREPARE THE PROJECT ARRAY sP = LoadProject(vP, vWB) '0 view original source data on sheet 1 '========================================================================= If bUseWorkSheets = True Then PrintArrayToSheet vP, "Sheet1" 'raw project '========================================================================= TrimStr vP, vS '1 remove end spc and tabs-not newlines JoinBrokenLines vS, vW '2 rejoin broken lines-leaves blank lines RemoveApostFmQuotes vW, vJ '3 RemoveAllComments vJ, vL '4 remove all comments-leaves blank lines RemoveBlankLines vL, vK '5 remove all blank lines-reduces line count RemoveQuotes vK, vM '6 remove all double quotes and their contents SplitAtColons vM, vV '7 make separate statement lines split at colons NumbersToRow vV, vU, 6 '8 new line count row 6; originals still in row 1 'DO NOT RENUMBER LINES BEYOND MarkLineRanges() MarkLineRanges vU, vR '9 mark array with line ranges for search later '========================================================================= If bUseWorkSheets = True Then PrintArrayToSheet vR, "Sheet2" 'mod project '========================================================================= 'get bounds of modified project line array Lb1 = LBound(vR, 1): Ub1 = UBound(vR, 1) Lb2 = LBound(vR, 2): Ub2 = UBound(vR, 2) 'redim of declared variables array ReDim vDec(1 To 12, 0 To 0) ReDim vDisp(1 To 4, 0 To 0) 'MAKE THE DECLARED VARIABLES ARRAY 'get one line of project array at a time 'if a declaration line, parse it and extract variables 'to build the declared variables array vDec For c = Lb2 To Ub2 DoEvents 'get one line of data from array sLN = CStr(vR(1, c)) 'original line number sPN = vR(3, c) 'project name sMN = vR(4, c) 'module name sProc = vR(5, c) 'procedure name sLS = vR(8, c) 'joined line string 'get declared variables from the line string If sProc <> "" Then bProcNamed = True Else bProcNamed = False GetDeclaredVariables sLS, bProcNamed, sVScope, vM If sVScope <> "" Then 'load declared variables array with dec vars for one line If UBound(vM) >= 1 Then 'it is a declaration line 'mark the source array string as a declaration line vR(13, c) = "Declaration" 'transfer found line variables to vDec For n = LBound(vM) To UBound(vM) ReDim Preserve vDec(1 To 12, 1 To UBound(vDec, 2) + 1) UDec2 = UBound(vDec, 2) 'vDec line number vDec(1, UDec2) = vM(n) 'Declared variable vDec(2, UDec2) = sPN 'Project name vDec(3, UDec2) = sMN 'Module name vDec(4, UDec2) = sProc 'Procedure name vDec(5, UDec2) = sVScope 'Scope of variable vDec(6, UDec2) = StartOfRng(vR, sVScope, c) 'Nominal line search start vDec(7, UDec2) = EndOfRng(vR, sVScope, c) 'Nominal line search end vDec(8, UDec2) = "" 'Used marking vDec(9, UDec2) = sLN 'Original line number vDec(10, UDec2) = "" 'Use checked marker vDec(11, UDec2) = vR(9, c) 'Module start line number vDec(12, UDec2) = vR(10, c) 'Module end line number Next n End If End If Next c EmptyTheDecLines vR, vT '10 replaces line string with empty string-no change line count 'DISPLAY CONDITIONED PROJECT ARRAY ON WORKSHEET '========================================================================= If bUseWorkSheets = True Then PrintArrayToSheet vT, "Sheet3" 'mod project '========================================================================= 'NOTES 'AT THIS POINT vT CONTAINS THE PROJECT LINES SOURCE TO SEARCH FOR USED VARIABLES. 'vT WILL ALSO BE USED TO SEARCH FOR THE USE OF DECLARED VARIABLES LISTED IN vDec. 'vDec LISTS THE INITIAL LINE NUMBERS RANGE FOR USE-SEARCH, THOUGH THESE ARE LATER MODIFIED. 'The use-search sequence is all procprivate, all modprivate, then all varpublic. 'All declared variables marked as used at one stage need not have their search ranges 'searched again at the next. Eg: Same-name procprivate-used could never be Modprivate-used also. 'Same-name varpublic variables could only apply as used where neither procprivate or modprivate. 'Nominally assigned searched ranges are modified after each stage to narrow the search line ranges 'for the next stage. 'Same-name public variables in each of several module heads are not yet handled. 'MARK THE DECLARED VARIABLES ARRAY WITH USE STATUS 'FIRST - MARK USE OF PROCPRIVATE vDec ITEMS MarkProcVarUse vDec, vT, vN vDec = vN MarkModVarUse vDec, vT, vAB vDec = vAB MarkPubVarUse vDec, vT, vX vDec = vX 'DISPLAY DECLARED VARIABLES ARRAY ON WORKSHEET '======================================================================================= If bUseWorkSheets = True Then PrintArrayToSheet vDec, "Sheet4" 'declared variables list '======================================================================================= 'LOAD REDUNDANT VARIABLES RESULTS ARRAY For n = LBound(vDec, 2) To UBound(vDec, 2) ' check whether or not marked used If vDec(8, n) = "" Then 'unused variable so transfer details If bNotFirst = True Then 'not first data transfer 'so increment array before transfer Upper = UBound(vDisp, 2) + 1 ReDim Preserve vDisp(1 To 4, 1 To Upper) Else 'is first data transfer 'so just use first element ReDim vDisp(1 To 4, 1 To 1) Upper = UBound(vDisp, 2) bNotFirst = True End If ' transfer variable details to display array vDisp(1, Upper) = vDec(1, n) 'variable name vDisp(2, Upper) = vDec(4, n) 'procedure name vDisp(3, Upper) = vDec(3, n) 'module name vDisp(4, Upper) = vDec(2, n) 'project name End If Next n ' report if none found If UBound(vDisp, 2) = 0 Then MsgBox "No redundant variables found for display" Exit Sub End If 'DISPLAY REDUNDANT VARIABLES RESULTS ON WORKSHEET '========================================================================================= If bUseWorkSheets = True Then PrintArrayToSheet vDisp, "Sheet5" 'redundant variables list '========================================================================================= 'DISPLAY REDUNDANT VARIABLES RESULTS ON USERFORM AutoLayout vDisp, 1 End Sub Function LoadProject(vR As Variant, wb As Variant) As String ' Loads local array with parameter workbook's ' whole VBA project string line by line, ' and other details, and returns in array vR. ' Whole project string can be found in LoadProject. ' Needs set reference to Microsoft VBA Extensibility 5.5 '============================================== ' Local String Array sW() Row Details. ' Each line record in one column '============================================== 'Row 1: Orig proj line number 'Row 2: Orig line string working 'Row 3: Project name 'Row 4: Module name 'Row 5: Procedure name 'Row 6: Reduced proj line number 'Row 7: Temp use for continuation marking 'Row 8: Rejoined versions of lines 'Row 9: Module start number 'Row 10: Module end number 'Row 11: Procedure start number 'Row 12: Procedure end number 'Row 13: n/a 'Row 14: n/a '============================================== Dim VBProj As VBIDE.VBProject, VBComp As VBIDE.VBComponent Dim VBMod As VBIDE.CodeModule, ProcKind As VBIDE.vbext_ProcKind Dim sMod As String, sProj As String, sLine As String Dim nLines As Long, n As Long, nC As Long, sW() As String Dim Ub2 As Long 'redim dynamic array Erase sW() ReDim sW(1 To 14, 1 To 1) 'get ref to parameter workbook Set VBProj = wb.VBProject 'loop through VBComponents collection For Each VBComp In VBProj.VBComponents Set VBMod = VBComp.CodeModule nLines = VBMod.CountOfLines sProj = sProj & VBMod.Lines(1, nLines) 'project string sMod = VBMod.Lines(1, nLines) 'module string If nLines <> 0 Then With VBMod For n = 1 To nLines DoEvents sLine = Trim(.Lines(n, 1)) 'line string 'Debug.Print sLine 'redim array for each record ReDim Preserve sW(1 To 14, 1 To nC + n) Ub2 = UBound(sW, 2) 'load lines of each module into array sW(1, Ub2) = CStr(Ub2) 'orig proj line number sW(2, Ub2) = sLine 'raw line string working sW(3, Ub2) = VBProj.Name 'project name sW(4, Ub2) = VBMod.Name 'module name sW(5, Ub2) = .ProcOfLine(n, ProcKind) 'procedure name sW(6, Ub2) = "" 'reduced proj line number sW(7, Ub2) = "" 'continuation mark working sW(8, Ub2) = "" 'long joined-up broken lines sW(9, Ub2) = "" 'Module start number sW(10, Ub2) = "" 'Module end number sW(11, Ub2) = "" 'Procedure start number sW(12, Ub2) = "" 'Procedure end number sW(13, Ub2) = "" 'n/a sW(14, Ub2) = "" 'n/a Next n End With End If nC = nC + nLines 'increment for next redim Next VBComp 'Debug.Print sproj LoadProject = sProj vR = sW() Set VBProj = Nothing: Set VBComp = Nothing Set VBMod = Nothing End Function Private Sub TrimStr(vA As Variant, vR As Variant) 'trims leading and lagging spaces and tabs 'from all input array vA code lines 'Returns array in vR Dim n As Long, c As Long Dim vW As Variant, str As String Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long 'get bounds of project array Lb1 = LBound(vA, 1): Ub1 = UBound(vA, 1) Lb2 = LBound(vA, 2): Ub2 = UBound(vA, 2) vW = vA 'modify the line strings of the array For c = Lb2 To Ub2 'get the line string str = vW(2, c) n = Len(str) Do 'delete tabs and spaces from left of string If Left(str, 1) = Chr(32) Or Left(str, 1) = Chr(9) Then n = Len(str) str = Right(str, n - 1) Else 'left is done Exit Do End If Loop Do 'delete tabs and spaces from right of string If Right(str, 1) = Chr(32) Or Right(str, 1) = Chr(9) Then n = Len(str) str = Left(str, n - 1) Else 'left is done Exit Do End If Loop 'pass back the mod string vW(2, c) = str Next c 'transfers vR = vW End Sub Sub JoinBrokenLines(vP As Variant, vR As Variant) 'Identifies and joins lines with continuation marks 'Whole lines placed into row 8 'Marks old broken bits as newlines. 'Newlines are removed later in RemoveBlankLines(). Dim vA As Variant, vW As Variant, IsContinuation As Boolean Dim str As String, sAccum As String, n As Long, s As Long Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long 'get bounds of project array Lb1 = LBound(vP, 1): Ub1 = UBound(vP, 1) Lb2 = LBound(vP, 2): Ub2 = UBound(vP, 2) ReDim vW(Lb1 To Ub1, Lb2 To Ub2) 'pass to work variable vW = vP 'mark all lines that have a continuation chara For n = LBound(vW, 2) To UBound(vW, 2) str = vW(2, n) 'line string IsContinuation = str Like "* _" If IsContinuation Then vW(7, n) = "continuation" Next n 'mark the start and end of every continuation group For n = LBound(vW, 2) To (UBound(vW, 2) - 1) If n = 1 Then 'for the first line only If vW(7, n) = "continuation" Then vW(8, n) = "SC" If vW(7, n) = "continuation" And vW(7, n + 1) <> "continuation" _ Then vW(8, n + 1) = "EC" Else 'for all lines after the first 'find ends If vW(7, n) = "continuation" And vW(7, n + 1) <> "continuation" Then vW(8, n + 1) = "EC" End If 'find starts If vW(7, n) = "continuation" And vW(7, n - 1) <> "continuation" Then 'If vw(7, n) <> "continuation" And vw(7, n + 1) = "continuation" Then vW(8, n) = "SC" End If End If Next n 'make single strings from each continuation group For n = LBound(vW, 2) To (UBound(vW, 2) - 1) If vW(8, n) = "SC" Then 'group starts 'join strings to make one string per continuation group s = n vA = Split(CStr(vW(2, n)), "_") str = CStr(vA(0)) sAccum = str Do Until vW(8, s) = "EC" s = s + 1 'handle other continued parts vA = Split(CStr(vW(2, s)), "_") str = CStr(vA(0)) sAccum = sAccum & str vW(2, s) = Replace(vW(2, s), vW(2, s), vbNewLine) Loop vW(8, n) = sAccum 'place at first line level in array End If str = "" sAccum = "" s = 0 Next n 'write remaining strings into row 8 for consistency 'all string parsing and other work now uses row 8 For n = Lb2 To Ub2 If vW(8, n) = "" Or vW(8, n) = "SC" Or vW(8, n) = "EC" Then vW(8, n) = Trim(vW(2, n)) End If Next n 'transfers vR = vW End Sub Sub RemoveApostFmQuotes(vB As Variant, vR As Variant) 'returns array vB as vR with apostrophies removed 'from between sets of double quotes, 'Remainder of quote and double quotes themselves left intact. 'for example s = "Dim eyes (Bob's)" becomes s = "Dim eyes (Bobs)" Dim str As String, str1 As String, vA As Variant, c As Long Dim n As Long, m As Long, bUnpaired As Boolean, r As Long Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long 'get bounds of project array Lb1 = LBound(vB, 1): Ub1 = UBound(vB, 1) Lb2 = LBound(vB, 2): Ub2 = UBound(vB, 2) ReDim vR(Lb1 To Ub1, Lb2 To Ub2) 'set up loop to get one line at a time For c = Lb2 To Ub2 str = vB(8, c) 'split string at double quotes If str <> "" Then vA = Split(str, """") Else 'empty string str1 = str GoTo Transfers End If 'recombine the splits m = UBound(vA) - LBound(vA) 'as long as even num of quote pairs If m Mod 2 = 0 Then For n = LBound(vA) To UBound(vA) If n Mod 2 = 0 Then 'even elements str1 = str1 & vA(n) Else 'odd elements 'apostrophies removed str1 = str1 & Replace(vA(n), "'", "") End If Next n Else 'unpaired double quotes detected bUnpaired = True End If Transfers: 'transfer one row only For r = Lb1 To Ub1 vR(r, c) = vB(r, c) Next r 'if all pairs matched If bUnpaired = False Then vR(8, c) = str1 Else 'exit loop with str End If str1 = "" 'reset accumulator bUnpaired = False Next c End Sub Sub RemoveAllComments(vA As Variant, vR As Variant) 'Removes all comments from vA row 8 line strings 'Includes comments front, middle and end so 'apostrophed text in double quotes would result 'in a false line split if not first removed. Dim bAny As Boolean, bStart As Boolean, bEnd As Boolean Dim n As Long, m As Long, c As Long, r As Long Dim bincluded As Boolean, l As Long, str As String Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long 'get bounds of project array Lb1 = LBound(vA, 1): Ub1 = UBound(vA, 1) Lb2 = LBound(vA, 2): Ub2 = UBound(vA, 2) ReDim vR(Lb1 To Ub1, 0 To 0) For c = Lb2 To Ub2 str = vA(8, c) 'detect any instance of a comment mark bAny = str Like "*'*" If Not bAny Then 'go for row INCLUSION action 'with original str bincluded = True GoTo Transfers Else 'comment front, 'middle, or 'end End If 'find whether or not has comment at front bStart = str Like "'*" If bStart Then 'go for row EXCLUSION action 'do not include row at all bincluded = False GoTo Transfers Else 'might still have comment at end End If 'find whether or not has comment at end bEnd = str Like "* '*" If bEnd Then 'remove comment at end l = Len(str) For n = 1 To l If Mid(str, n, 2) = " '" Then str = Trim(Left(str, n - 1)) 'go for row INCLUSION action 'with modified str bincluded = True GoTo Transfers End If Next n End If 'decide on how to do the default thing Transfers: If bincluded = True Then 'include the current row m = m + 1 ReDim Preserve vR(Lb1 To Ub1, 1 To m) For r = Lb1 To Ub1 vR(r, m) = vA(r, c) Next r vR(8, m) = str Else 'do not include the current row End If Next c End Sub Sub RemoveBlankLines(vA As Variant, vR As Variant) 'removes all blank lines from proj array vA 'and returns with modified array in vR 'Changes line count Dim vM As Variant, bNotFirst As Boolean Dim c As Long, r As Long, Upper As Long Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long 'get bounds of project array Lb1 = LBound(vA, 1): Ub1 = UBound(vA, 1) Lb2 = LBound(vA, 2): Ub2 = UBound(vA, 2) ReDim vM(Lb1 To Ub1, 1 To 1) For c = Lb2 To Ub2 If vA(8, c) <> "" And vA(8, c) <> vbNewLine Then If bNotFirst = True Then 'not first data transfer 'so increment array before transfer Upper = UBound(vM, 2) + 1 ReDim Preserve vM(Lb1 To Ub1, 1 To Upper) Else 'is first data transfer 'so just use first element Upper = UBound(vM, 2) bNotFirst = True End If 'transfer data For r = Lb1 To Ub1 vM(r, Upper) = vA(r, c) Next r End If Next c vR = vM End Sub Sub RemoveQuotes(vB As Variant, vR As Variant) 'returns array vB as vR with all text between pairs 'of double quotes removed, and double quotes themselves 'for example s = "Dim eyes" becomes s = 'A failed quotes pairing returns original string. Dim str As String, str1 As String, vA As Variant, c As Long Dim n As Long, m As Long, bUnpaired As Boolean, r As Long Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long 'get bounds of project array Lb1 = LBound(vB, 1): Ub1 = UBound(vB, 1) Lb2 = LBound(vB, 2): Ub2 = UBound(vB, 2) ReDim vR(Lb1 To Ub1, Lb2 To Ub2) 'set up loop to get one line at a time For c = Lb2 To Ub2 str = vB(8, c) 'split string at double quotes If str <> "" Then vA = Split(str, """") Else 'empty string str1 = str GoTo Transfers End If 'overwrite odd elements to be empty strings m = UBound(vA) - LBound(vA) 'as long as even num of quote pairs If m Mod 2 = 0 Then For n = LBound(vA) To UBound(vA) 'accum even elements If n Mod 2 = 0 Then str1 = str1 & vA(n) End If Next n Else 'unpaired double quotes detected bUnpaired = True End If Transfers: 'transfer one row only For r = Lb1 To Ub1 vR(r, c) = vB(r, c) Next r 'if all pairs matched If bUnpaired = False Then vR(8, c) = str1 Else 'exit loop with str End If str1 = "" 'reset accumulator bUnpaired = False Next c End Sub Sub SplitAtColons(vA As Variant, vR As Variant) 'Because statements and other lines can be placed 'in line and separated by colons, they must be split. 'Splits such into separate lines and increases line count, 'Input array in vA and returns in vR. 'Note: The space after colon is distinct from named arguments 'that have no space after the colon. Dim vF As Variant, vW As Variant Dim n As Long, sLine As String, bNotFirst As Boolean Dim Elem As Variant, m As Long, Upper As Long Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long 'get bounds of project array Lb1 = LBound(vA, 1): Ub1 = UBound(vA, 1) Lb2 = LBound(vA, 2): Ub2 = UBound(vA, 2) ReDim vW(Lb1 To Ub1, Lb2 To Ub2) ReDim vR(Lb1 To Ub1, 1 To 1) 'pass to work variable vW = vA For n = Lb2 To Ub2 'for each line existing 'get line string sLine = Trim(vW(8, n)) 'decide if has colons 'do the split vF = Split(sLine, ": ") 'does it contain colons? If UBound(vF) >= 1 Then 'there were non-arg colons 'make a new line in return array for each elem For Each Elem In vF Elem = Trim(CStr(Elem)) If Elem <> "" Then If bNotFirst = True Then 'not first data transfer 'so increment array before transfer Upper = UBound(vR, 2) + 1 ReDim Preserve vR(Lb1 To Ub1, 1 To Upper) Else 'is first data transfer 'so just use first element Upper = UBound(vR, 2) bNotFirst = True End If 'transfer line of vW to vR For m = 1 To 8 vR(m, Upper) = vW(m, n) Next m vR(8, Upper) = Elem 'overwrite line string End If Next Elem Else 'no colons - redim array and normal line transfer If bNotFirst = True Then 'not first data transfer 'so increment array before transfer Upper = UBound(vR, 2) + 1 ReDim Preserve vR(Lb1 To Ub1, 1 To Upper) Else 'is first data transfer 'so just use first element Upper = UBound(vR, 2) bNotFirst = True End If ReDim Preserve vR(Lb1 To Ub1, 1 To Upper) 'transfer line of vW to vR For m = Lb1 To Ub1 vR(m, Upper) = vW(m, n) Next m End If Next n End Sub Sub NumbersToRow(vA As Variant, vR As Variant, Optional nRow As Long = 6) 'adds renumbering of current array lines to row 6. 'and returns vA array in vR. Original numbers still in row 1. 'Optional row number defaults to 6 Dim n As Long Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long 'get bounds of project array Lb1 = LBound(vA, 1): Ub1 = UBound(vA, 1) Lb2 = LBound(vA, 2): Ub2 = UBound(vA, 2) ReDim vR(Lb1 To Ub1, Lb2 To Ub2) For n = Lb2 To Ub2 vA(nRow, n) = n Next n vR = vA End Sub Sub MarkLineRanges(vA As Variant, vR As Variant) 'Input array in vA, returned in vR with markings. 'Adds any module and procedure line ranges 'that may apply, for every line of vA. These figures 'will be used for the nominal search line ranges. Dim nS As Long, sS As String, vW As Variant, n As Long Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long 'get bounds of project array Lb1 = LBound(vA, 1): Ub1 = UBound(vA, 1) Lb2 = LBound(vA, 2): Ub2 = UBound(vA, 2) ReDim vR(Lb1 To Ub1, Lb2 To Ub2) vW = vA 'MODULE START RANGE 'get the start point values in place sS = Trim(vW(4, 1)) 'get first module name nS = CLng(Trim(vW(6, 1))) 'get line number for first module entry vW(9, Lb2) = nS For n = Lb2 To Ub2 - 1 'If vW(5, n) = "" Then 'it is a module entry 'count same items If vW(4, n) = vW(4, n + 1) Then 'still same module name 'so mark start value same vW(9, n + 1) = nS Else 'n+1 when not same sS = vW(4, n + 1) vW(9, n) = nS nS = vW(6, n + 1) vW(9, n + 1) = nS End If Next n 'MODULE END RANGE sS = Trim(vW(4, Ub2)) 'get last module name nS = CLng(Trim(vW(6, Ub2))) 'get line number for first module entry vW(10, Ub2) = nS For n = Ub2 To (Lb2 + 1) Step -1 'If vW(5, n) = "" Then 'it is a module entry 'count same items If vW(4, n) = vW(4, n - 1) Then 'still same module name 'so mark start value same vW(10, n - 1) = nS Else 'n+1 when not same sS = vW(4, n - 1) vW(10, n) = nS nS = vW(6, n - 1) vW(10, n - 1) = nS End If Next n 'PROCEDURE START RANGE 'get the start point values in place sS = Trim(vW(5, 1)) 'get first procedure name nS = CLng(Trim(vW(6, 1))) 'get line number proc entry vW(11, Lb2) = nS For n = Lb2 To Ub2 - 1 'If vW(5, n) = "" Then 'it is a module entry 'count same items If vW(5, n) = vW(5, n + 1) Then 'still same module name 'so mark start value same vW(11, n + 1) = nS Else 'n+1 when not same sS = vW(5, n + 1) vW(11, n) = nS nS = vW(6, n + 1) vW(11, n + 1) = nS End If Next n 'PROCEDURE END RANGE sS = Trim(vW(5, Ub2)) 'get last proc name nS = CLng(Trim(vW(6, Ub2))) 'get line number proc entry vW(12, Ub2) = nS For n = Ub2 To (Lb2 + 1) Step -1 'If vW(5, n) = "" Then 'it is a module entry 'count same items If vW(5, n) = vW(5, n - 1) Then 'still same module name 'so mark start value same vW(12, n - 1) = nS Else 'n+1 when not same sS = vW(5, n - 1) vW(12, n) = nS nS = vW(6, n - 1) vW(12, n - 1) = nS End If Next n 'ADD PUBLIC VARIABLE LINE RANGES 'public variable line ranges need not be marked 'since the whole project line range applies 'transfers vR = vW End Sub Sub GetDeclaredVariables(sLine As String, bProcName As Boolean, sScope As String, vRet As Variant) 'Returns an array of declared variables in line string sLine. 'This is used to build the declared variables array (vDec) in RunVarChecks(). 'bProcName input is true if sLine project record lists a procedure name, else false. 'sScope outputs scope of line declarations returned in vRet. 'sScope values are "PROCPRIVATE", "DECLARED", "MODPRIVATE", or "VARPUBLIC" '========================================================================= 'sScope RETURNS: '"PROCPRIVATE"; returned if declaration is private to a procedure '"MODPRIVATE"; returned if declaration is private to a module '"VARPUBLIC"; returned if declaration is public '"DECLARED"; returned if declared with keyword "Declared" in heading '========================================================================= Dim IsDim As Boolean, nL As Long, vF As Variant Dim Elem As Variant, vS As Variant, vT As Variant Dim bPrivate As Boolean, bPublic As Boolean, bStatic As Boolean Dim bPrivPubStat As Boolean, bDeclare As Boolean, bType As Boolean Dim bSub As Boolean, bFunc As Boolean, bConst As Boolean Dim n As Long, Upper As Long, bNotFirst As Boolean ' '---------------------------------------------------------------------------- ' Handle exclusions: lines that contain any of the declaration keywords; ' "Declare", "Const", and "Type" ' '---------------------------------------------------------------------------- bDeclare = sLine Like "* Declare *" Or sLine Like "Declare *" bConst = sLine Like "* Const *" Or sLine Like "Const *" bType = sLine Like "* Type *" Or sLine Like "Type *" If bDeclare Or bConst Or bType Then GoTo DefaultTransfer End If '---------------------------------------------------------------------------- ' Then, check declarations that were made with the "Dim" statement, ' at private module and at procedure level. '---------------------------------------------------------------------------- 'sLine = "Dim IsDim As Boolean, nL As Long, vF(1 to4,4 to 6,7 to 10) As Variant" sLine = Trim(sLine) ReDim vT(0 To 0) IsDim = sLine Like "Dim *" 'could be proc or module level If IsDim Then nL = Len(sLine) sLine = Right(sLine, nL - 4) 'do the first split sLine = RemoveVarArgs(sLine) vF = Split(sLine, ",") 'do the second split For Each Elem In vF Elem = Trim(CStr(Elem)) If Elem <> "" Then vS = Split(Elem, " ") 'Optional might still preceed var name For n = LBound(vS) To UBound(vS) If vS(n) <> "Optional" Then 'redim the array If bNotFirst = True Then 'not first data transfer 'so increment array before transfer Upper = UBound(vT) + 1 ReDim Preserve vT(LBound(vT) To Upper) Else 'is first data transfer 'so just use first element ReDim vT(1 To 1) Upper = UBound(vT) bNotFirst = True End If vT(Upper) = vS(n) Exit For End If Next n End If Next Elem 'return results If UBound(vT, 1) >= 1 Then If bProcName = True Then Transfer1: sScope = "PROCPRIVATE" Else sScope = "MODPRIVATE" End If vRet = vT Exit Sub 'Function End If Else: 'not a dim item so... GoTo CheckProcLines End If CheckProcLines: '--------------------------------------------------------------------------------- ' Check declarations that were made in public and private procedure definitions. ' Procedure definitions made in the module heading with declare are excluded. '--------------------------------------------------------------------------------- bSub = sLine Like "*Sub *(*[A-z]*)*" bFunc = sLine Like "*Function *(*[A-z]*)*" If bSub Or bFunc Then 'obtain contents of first set round brackets sLine = GetProcArgs(sLine) 'obtain vars without args sLine = RemoveVarArgs(sLine) 'first split vF = Split(sLine, ",") For Each Elem In vF Elem = Trim(CStr(Elem)) If Elem <> "" Then 'second split vS = Split(Elem, " ") 'any of Optional, ByVal, ByRef, or ParamArray might preceed var name For n = LBound(vS) To UBound(vS) If vS(n) <> "Declare" And vS(n) <> "Optional" And vS(n) <> "ByVal" And _ vS(n) <> "ByRef" And vS(n) <> "ParamArray" Then 'redim the array If bNotFirst = True Then 'not first data transfer 'so increment array before transfer Upper = UBound(vT) + 1 ReDim Preserve vT(LBound(vT) To Upper) Else 'is first data transfer 'so just use first element ReDim vT(1 To 1) Upper = UBound(vT) bNotFirst = True End If vT(Upper) = vS(n) Exit For End If Next n End If Next Elem 'return results if any found in section If UBound(vT) >= 1 Then If bProcName = True Then Transfers2: sScope = "PROCPRIVATE" Else 'exits with empty sScope sScope = "" End If vRet = vT Exit Sub End If Else 'not a dec proc line so... GoTo OtherVarDecs End If OtherVarDecs: '-------------------------------------------------------------------------------------------- ' Check variable declarations at module level outside of any procedures that ' use the private, public, or static keywords. Dim decs were considered in first section. '-------------------------------------------------------------------------------------------- 'test line for keywords bSub = sLine Like "* Sub *" bFunc = sLine Like "* Function *" bPrivate = sLine Like "Private *" bPublic = sLine Like "Public *" bStatic = sLine Like "Static *" If bPrivate Or bPublic Or bStatic Then bPrivPubStat = True 'exclude module procs but include mod vars If bConst Then GoTo DefaultTransfer If bPrivPubStat And Not bSub And Not bFunc Then 'remove variable args brackets altogether sLine = RemoveVarArgs(sLine) 'first split vF = Split(sLine, ",") For Each Elem In vF Elem = Trim(CStr(Elem)) If Elem <> "" Then vS = Split(Elem, " ") 'any of private, public, or withEvents could preceed var name For n = LBound(vS) To UBound(vS) If vS(n) <> "Private" And vS(n) <> "Public" And _ vS(n) <> "WithEvents" Then 'redim the array If bNotFirst = True Then 'not first data transfer 'so increment array before transfer Upper = UBound(vT) + 1 ReDim Preserve vT(LBound(vT) To Upper) Else 'is first data transfer 'so just use first element ReDim vT(1 To 1) Upper = UBound(vT) bNotFirst = True End If vT(Upper) = vS(n) Exit For End If Next n End If Next Elem 'return array and results If UBound(vT) >= 1 Then If bPrivate Then Transfers3: sScope = "MODPRIVATE" ElseIf bPublic Then sScope = "VARPUBLIC" End If vRet = vT Exit Sub End If Else 'not a mod private ,public, etc, so... GoTo DefaultTransfer End If DefaultTransfer: 'no declarations in this line 'so hand back empty vT(0 to 0) sScope = "" vRet = vT End Sub Function GetProcArgs(str As String) As String 'Extracts and returns content of FIRST set of round brackets 'This releases the procedure arguments bundle, 'Brackets of arguments themselves removed in RemoveVarArgs. Dim LeadPos As Long, LagPos As Long Dim LeadCount As Long, LagCount As Long, Length As Long Dim n As Long, sTemp1 As String, m As Long Length = Len(Trim(str)) For n = 1 To Length If Mid(str, n, 1) = "(" Then LeadCount = LeadCount + 1 LeadPos = n For m = LeadPos + 1 To Length If Mid(str, m, 1) = "(" Then LeadCount = LeadCount + 1 End If If Mid(str, m, 1) = ")" Then LagCount = LagCount + 1 End If If LeadCount = LagCount And LeadCount <> 0 Then LagPos = m 'extract the string from between Leadcount and LagCount, without brackets sTemp1 = Mid(str, LeadPos + 1, LagPos - LeadPos - 1) GetProcArgs = sTemp1 'return Exit Function End If Next m End If Next n End Function Function RemoveVarArgs(ByVal str As String) As String 'Removes ALL round brackets and their content from str input. 'Returns modified string in function name RemoveVarArgs. '============================================================ 'Notes: REMOVES ALL ROUND BRACKETS AND THEIR CONTENTS 'the string: dim Arr(1 to 3, 3 to (6+3)), Var() as String 'becomes: dim Arr, Var as String '============================================================ Dim bIsAMatch As Boolean, LeadPos As Long, LagPos As Long Dim LeadCount As Long, LagCount As Long, Length As Long Dim n As Long, sTemp1 As String, sTemp2 As String, m As Long Do DoEvents bIsAMatch = str Like "*(*)*" If Not bIsAMatch Then Exit Do Length = Len(Trim(str)) For n = 1 To Length If Mid(str, n, 1) = "(" Then LeadCount = LeadCount + 1 LeadPos = n For m = LeadPos + 1 To Length If Mid(str, m, 1) = "(" Then LeadCount = LeadCount + 1 End If If Mid(str, m, 1) = ")" Then LagCount = LagCount + 1 End If If LeadCount = LagCount And LeadCount <> 0 Then LagPos = m 'remove current brackets and all between them sTemp1 = Mid(str, LeadPos, LagPos - LeadPos + 1) sTemp2 = Replace(str, sTemp1, "", 1) str = sTemp2 Exit For End If Next m End If bIsAMatch = str Like "*(*)*" If Not bIsAMatch Then Exit For Next n LeadCount = 0 LagCount = 0 LeadPos = 0 LagPos = 0 Loop RemoveVarArgs = str 'return End Function Sub EmptyTheDecLines(vA As Variant, vR As Variant) 'Input array in vA, returned in vR modified. 'Overwrites row 8 line string with empty string 'if line is marked in proj array as a declaration line, 'but leaves other parts of that record intact. Dim c As Long Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long 'get bounds of project array Lb1 = LBound(vA, 1): Ub1 = UBound(vA, 1) Lb2 = LBound(vA, 2): Ub2 = UBound(vA, 2) ReDim vR(Lb1 To Ub1, Lb2 To Ub2) vR = vA For c = Lb2 To Ub2 If vA(13, c) = "Declaration" Then vR(8, c) = "" End If Next c End Sub Function MarkProcVarUse(vA As Variant, vT As Variant, vR As Variant) As Boolean 'Updates vDec declared variables array with use data for 'variables declared in procedures. 'Takes vDec in vA and returns modified with markup in vR. 'vT is the project code lines array. Dim sD As String, sL As String, n As Long, m As Long Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long 'get bounds of vDec input as vA Lb1 = LBound(vA, 1): Ub1 = UBound(vA, 1) Lb2 = LBound(vA, 2): Ub2 = UBound(vA, 2) ReDim vR(Lb1 To Ub1, Lb2 To Ub2) vR = vA 'step through declared variables array names For n = LBound(vR, 2) To UBound(vR, 2) 'get one declared variable at a time... sD = vR(1, n) 'for its associated nominal search lines... For m = vR(6, n) To vR(7, n) 'and if not a declaration line... If vT(8, m) <> "" And vR(5, n) = "PROCPRIVATE" Then 'get project line to check... sL = vT(8, m) 'check project line against all use patterns If PatternCheck(sL, sD) Then 'mark declared var line as used vR(8, n) = "Used" Exit For Else End If End If Next m Next n End Function Function MarkModVarUse(vA As Variant, vT As Variant, vR As Variant) As Boolean 'Updates vDec declared variables array with use data 'for variables declared at module-private level. 'Takes vDec in vA and returns modified with markup in vR. 'vT is the project code lines array. Dim sA1 As String, sA2 As String, sL As String, q As Long Dim sD As String, n As Long, m As Long, vRet As Variant Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long 'get bounds of vDec input as vA Lb1 = LBound(vA, 1): Ub1 = UBound(vA, 1) Lb2 = LBound(vA, 2): Ub2 = UBound(vA, 2) ReDim vR(Lb1 To Ub1, Lb2 To Ub2) vR = vA 'CHECK MODPRIVATE ALIAS NAMES IN WHOLE MODULES 'without any line restriction 'no harm in doing all modprivate this way first 'step through declared variables array For n = Lb2 To Ub2 'If item is modprivate... If vR(5, n) = "MODPRIVATE" Then 'get both alias names for one variable... sA1 = vR(3, n) & "." & vR(1, n) 'mod.var sA2 = vR(2, n) & "." & vR(3, n) & "." & vR(1, n) 'proj.mod.var 'for whole module line set... For m = vR(11, n) To vR(12, n) 'get proj line sL = vT(8, m) 'check line against vR use patterns... If PatternCheck(sL, sA1) Then 'mark declared vRriable as used vR(8, n) = "Used" Exit For End If If PatternCheck(sL, sA2) Then 'mark declared vRriable as used vR(8, n) = "Used" Exit For End If Next m Else 'action for not modprivate End If Next n 'then... 'CHECK MODPRIVATE SHORT NAMES AGAINST WHOLE MODULES 'excluding proc lines using vars with same names 'step through declared variables array For n = Lb2 To Ub2 'if not already found to be used in above section... If vR(5, n) = "MODPRIVATE" And vR(8, n) <> "Used" Then 'get its usual short form var name sD = vR(1, n) 'get a modified search range to exclude proc same-names NewRange vR, n, CLng(vR(6, n)), CLng(vR(7, n)), vRet 'search for pattern match in restricted range For q = LBound(vRet) To UBound(vRet) 'if not a declaration line, and n is modprivate, and a permitted search line If vT(8, q) <> "" And vR(5, n) = "MODPRIVATE" And vRet(q) = "" Then 'search in project array with line q sL = vT(8, q) If PatternCheck(sL, sD) Then vR(8, n) = "Used" Exit For End If End If Next q End If Next n End Function Function MarkPubVarUse(vA As Variant, vT As Variant, vR As Variant) As Boolean 'Updates vDec declared variables array with use data 'for variables declared as public in module heads. 'Takes vDec in vA and returns modified with markup in vR. 'vT is the project code lines array. Dim sA1 As String, sA2 As String, sL As String, q As Long Dim sD As String, n As Long, m As Long, vRet As Variant Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long 'get bounds of vDec input as vA Lb1 = LBound(vA, 1): Ub1 = UBound(vA, 1) Lb2 = LBound(vA, 2): Ub2 = UBound(vA, 2) ReDim vR(Lb1 To Ub1, Lb2 To Ub2) vR = vA GeneralChecks: 'CHECK VARPUBLIC ALIAS NAMES IN WHOLE PROJECT 'DO THIS IN EVERY CASE 'without any line restrictions 'do this for all varpublic items first 'step through declared variables array For n = Lb2 To Ub2 'If item is varpublic... If vR(5, n) = "VARPUBLIC" And vR(8, n) <> "Used" Then 'get both alias names for one variable... sA1 = vR(3, n) & "." & vR(1, n) 'mod.vRr sA2 = vR(2, n) & "." & vR(3, n) & "." & vR(1, n) 'proj.mod.vRr 'for whole project line set... For m = LBound(vT, 2) To UBound(vT, 2) 'get proj line sL = vT(8, m) 'check line against vR use patterns... If PatternCheck(sL, sA1) Then 'mark declared vRriable as used vR(8, n) = "Used" Exit For End If If PatternCheck(sL, sA2) Then 'mark declared vRriable as used vR(8, n) = "Used" Exit For End If Next m End If Next n 'then... 'CHECK VARPUBLIC SHORT NAME USE DEPENDING ON ANY NAME DUPLICATION 'step through declared variables array For n = Lb2 To Ub2 'if not already found to be used in above section... If vR(5, n) = "VARPUBLIC" And vR(8, n) <> "Used" Then 'get its usual var name sD = vR(1, n) ' Ambiguous returns true if other pub vars use same name If Ambiguous(vR, n) Then Ambiguous: 'CHECK VARPUBLIC SHORT NAME USE IN MODULES ONLY -similars already checked fully 'get a modified search range to exclude proc same-names NewRange vR, n, CLng(vR(11, n)), CLng(vR(12, n)), vRet 'run through newly permitted module search lines For q = LBound(vRet) To UBound(vRet) 'if not a declaration line, and n is modprivate, and a permitted search line If vT(8, q) <> "" And vR(5, n) = "VARPUBLIC" And vRet(q) = "" Then 'search in project array with line q sL = vT(8, q) If PatternCheck(sL, sD) Then vR(8, n) = "Used" Exit For End If End If Next q Else Unambiguous: 'resolve use when there is no ambiguous variable duplication anywhere 'CHECK VARPUBLIC SHORT NAME USE IN WHOLE PROJECT 'get a modified search range to exclude proc and module same-names NewPubRange vR, n, LBound(vT, 2), UBound(vT, 2), vRet 'run through newly permitted project search lines For q = LBound(vRet) To UBound(vRet) 'if not a declaration line, and n is varpublic, and a permitted search line If vT(8, q) <> "" And vR(5, n) = "VARPUBLIC" And vRet(q) = "" Then 'search in project array with line q sL = vT(8, q) If PatternCheck(sL, sD) Then vR(8, n) = "Used" Else End If End If Next q End If End If Next n End Function Function Ambiguous(vA As Variant, n As Long) As Boolean 'Returns function name as true if the public variable 'in line number n of vDec has duplicated use of its 'name elsewhere in vDec declared variables listing, 'by another public variable, else it is false. 'Public variables CAN exist with same names. Dim m As Long Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long 'get bounds of vDec input as vA Lb1 = LBound(vA, 1): Ub1 = UBound(vA, 1) Lb2 = LBound(vA, 2): Ub2 = UBound(vA, 2) 'step through vDec as vA checking item n against all others For m = Lb2 To Ub2 'if rows different,names same,projects same,and both varpublic... If m <> n And vA(1, n) = vA(1, m) And vA(2, n) = vA(2, m) And _ vA(5, n) = "VARPUBLIC" And vA(5, m) = "VARPUBLIC" Then 'there is duplication for public variable name in row n Ambiguous = True Exit Function End If Next m End Function Function NewPubRange(vA As Variant, n As Long, nS As Long, nE As Long, vR As Variant) As Boolean 'Input is vDec array in vA. Returns vR array with search restriction markings. 'Used for public variable use search in MarkPubVarUsewhen there is no ambiguous naming at all. 'The nominal search range is input as nS and nE,and this line range will be marked to search or not. 'Input n is vDec line number for the public variable name that needs a search data range returned. 'vR array elements are marked "X" to avoid that line and "" to search it in the project array. Dim nSS As Long, nSE As Long Dim strD As String, m As Long, p As Long Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long 'get bounds of vDec input as vA Lb1 = LBound(vA, 1): Ub1 = UBound(vA, 1) Lb2 = LBound(vA, 2): Ub2 = UBound(vA, 2) 'set size of return array equal to number of nominal search lines 'that is for this proc the entire project range ReDim vR(nS To nE) 'get usual var name strD = vA(1, n) 'search for variable name in declared variables array For m = Lb2 To Ub2 'if not same rows, and var name same, and project same, and was used... 'then its proc or module search lines all need excluded from project search If n <> m And strD = vA(1, m) And vA(2, n) = vA(2, m) And vA(8, m) = "Used" Then 'get item's range to exclude nSS = vA(6, m) 'start nominal range for samename item nSE = vA(7, m) 'end nominal range for samename item 'mark vR with exclusion marks For p = nSS To nSE vR(p) = "X" 'exclude this line Next p End If Next m NewPubRange = True End Function Function NewRange(vA As Variant, n As Long, nS As Long, nE As Long, vR As Variant) As Boolean 'Used for both public and module variable name search. For short form of name. 'Makes an array that is used to restrict the used-var search range. 'nS and nE are start and end nominal search line numbers. 'Input is vDec in vA, n is vDec line number for variable under test, vR is return array. 'returns array vR marked "X" for exclusion of search where a procedure has a 'same-name variable to that of line n in vDec. Restricts the nominal search range. Dim nSS As Long, nSE As Long Dim strD As String, m As Long, p As Long Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long 'get bounds of vDec input as vA Lb1 = LBound(vA, 1): Ub1 = UBound(vA, 1) Lb2 = LBound(vA, 2): Ub2 = UBound(vA, 2) 'set size of return array equal to number of nominal search lines ReDim vR(nS To nE) 'get usual var name strD = vA(1, n) 'search for variable name in declared variables array For m = Lb2 To Ub2 'if not same rows, and var name same, and project same, and module same, and has a procedure name, 'and was used...then its proc search lines all need excluded from module search If n <> m And strD = vA(1, m) And vA(2, n) = vA(2, m) And vA(3, n) = vA(3, m) And _ vA(4, m) <> "" And vA(8, m) = "Used" Then 'in a proc 'get item's range to exclude nSS = vA(6, m) 'start nominal range for samename item nSE = vA(7, m) 'end nominal range samename item 'mark vR with exclusion marks For p = nSS To nSE vR(p) = "X" 'exclude this line Next p End If Next m NewRange = True End Function Function StartOfRng(vA As Variant, sScp As String, n As Long) As Long 'Returns line number in function name that starts nominal search range. 'Information already on the project array. Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long 'get bounds of project array Lb1 = LBound(vA, 1): Ub1 = UBound(vA, 1) Lb2 = LBound(vA, 2): Ub2 = UBound(vA, 2) 'get ranges using new line numbers in row 6 Select Case sScp Case "PROCPRIVATE" StartOfRng = vA(11, n) Case "MODPRIVATE" StartOfRng = vA(9, n) Case "VARPUBLIC" StartOfRng = LBound(vA, 2) Case "DECLARED" 'StartOfRng = vA(9, n) Case Else MsgBox "Dec var scope not found" End Select End Function Function EndOfRng(vA As Variant, sScp As String, n As Long) As Long 'Returns line number in function name for end of used search 'Information already on the project array Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long 'get bounds of project array Lb1 = LBound(vA, 1): Ub1 = UBound(vA, 1) Lb2 = LBound(vA, 2): Ub2 = UBound(vA, 2) 'get ranges using new line numbers in row 6 Select Case sScp Case "PROCPRIVATE" EndOfRng = vA(12, n) Case "MODPRIVATE" EndOfRng = vA(10, n) Case "VARPUBLIC" EndOfRng = UBound(vA, 2) Case "DECLARED" 'EndOfRng = vA(10, n) Case Else MsgBox "Dec var scope not found" End Select End Function Sub PrintArrayToSheet(vA As Variant, sSht As String) 'Used at various points in project to display test info 'Writes input array vA to sSht with top left at cells(1,1) 'Sheet writing assumes lower bound of array is 1 'Makes use of Transpose2DArr() Dim sht As Worksheet, r As Long, c As Long Dim Ub1 As Long, Lb1 As Long, Lb2 As Long, Ub2 As Long, vRet As Variant Transpose2DArr vA, vRet 'get bounds of project array Lb1 = LBound(vRet, 1): Ub1 = UBound(vRet, 1) Lb2 = LBound(vRet, 2): Ub2 = UBound(vRet, 2) If Lb1 <> 0 And Lb2 <> 0 And Ub1 <> 0 And Ub2 <> 0 Then Set sht = ThisWorkbook.Worksheets(sSht) sht.Activate For r = Lb1 To Ub1 For c = Lb2 To Ub2 sht.Cells(r, c) = vRet(r, c) Next c Next r sht.Cells(1, 1).Select Else 'MsgBox "No redundant variables found." End If End Sub Function Transpose2DArr(ByRef vA As Variant, Optional ByRef vR As Variant) As Boolean ' Used in both user form and sheet output displays. ' Transposes a 2D array of numbers or strings. ' Returns the transposed vA array as vR with vA intact. Dim loR As Long, hiR As Long, loC As Long, hiC As Long Dim r As Long, c As Long 'find bounds of vA data input array loR = LBound(vA, 1): hiR = UBound(vA, 1) loC = LBound(vA, 2): hiC = UBound(vA, 2) 'set vR dimensions transposed 'If Not IsMissing(vR) Then If IsArray(vR) Then Erase vR ReDim vR(loC To hiC, loR To hiR) 'End If 'transfer data For r = loR To hiR For c = loC To hiC 'transpose vA into vR vR(c, r) = vA(r, c) Next c Next r Transfers: 'return success for function Transpose2DArr = True End Function Sub StrToNextRow(sIn As String, sSht As String, Optional nCol As Long = 1) 'Writes to next free row of nCol. 'Optional parameter nCol defaults to unity. 'sIn: String input to display, sSht: Worksheet string name to write to. Dim sht As Worksheet, nRow As Long Set sht = ThisWorkbook.Worksheets(sSht) sht.Activate nRow = Cells(Rows.Count, nCol).End(xlUp).Row + 1 sht.Cells(nRow, nCol).Activate ActiveCell.Value = sIn End Sub Function PatternCheck(sLine As String, sDec As String) As Boolean 'Used to determine whether or not a declared variable is used. 'Returns PatternCheck as true if sDec was used 'in sLine, else false. sDec is the declared variable 'and sLine is the previously modified code line. Modifications 'removed quotes and comments that can cause error. 'Checks against a set of common use patterns. 'Dim sLine As String, sDec As String Dim bIsAMatch As Boolean, n As Long Dim Lb2 As Long, Ub2 As Long For n = Lb2 To Ub2 'if parameter found in format of pattern returns true - else false 'IN ORDER OF FREQUENCY OF USE; 'PATTERNS FOR FINDING WHETHER OR NOT A VARIABLE IS USED IN A LINE STRING 'A = Var + 1 or A = b + Var + c bIsAMatch = sLine Like "* " & sDec & " *" 'spaced both sides If bIsAMatch Then Exit For 'Var = 1 bIsAMatch = sLine Like sDec & " *" 'lead nothing and lag space If bIsAMatch Then Exit For 'B = Var bIsAMatch = sLine Like "* " & sDec 'lead space and lag nothing If bIsAMatch Then Exit For 'Sub Name(Var, etc) bIsAMatch = sLine Like "*(" & sDec & ",*" 'lead opening bracket and lag comma If bIsAMatch Then Exit For 'B = C(n + Var) bIsAMatch = sLine Like "* " & sDec & ")*" 'lead space and lag close bracket If bIsAMatch Then Exit For 'B = "t" & Var.Name bIsAMatch = sLine Like "* " & sDec & ".*" 'lead space and lag dot If bIsAMatch Then Exit For 'B = C(Var + n) bIsAMatch = sLine Like "*(" & sDec & " *" 'lead open bracket and lag space If bIsAMatch Then Exit For 'B = (Var) bIsAMatch = sLine Like "*(" & sDec & ")*" 'lead open bracket and lag close bracket If bIsAMatch Then Exit For 'Var.Value = 5 bIsAMatch = sLine Like sDec & ".*" 'lead nothing and lag dot If bIsAMatch Then Exit For 'A = Var(a, b) 'Redim Var(1 to 6, 3 to 8) 'ie: redim is commonly treated as use, but never as declaration. bIsAMatch = sLine Like "* " & sDec & "(*" 'lead space and lag open bracket If bIsAMatch Then Exit For 'Var(a) = 1 bIsAMatch = sLine Like sDec & "(*" 'lead nothing and lag open bracket If bIsAMatch Then Exit For 'B = (Var.Name) bIsAMatch = sLine Like "*(" & sDec & ".*" 'lead opening bracket and lag dot If bIsAMatch Then Exit For 'SubName Var, etc bIsAMatch = sLine Like "* " & sDec & ",*" 'lead space and lag comma If bIsAMatch Then Exit For 'B = (Var(a) - c) bIsAMatch = sLine Like "*(" & sDec & "(*" 'with lead open bracket and lag open bracket If bIsAMatch Then Exit For 'Test Var:=Name bIsAMatch = sLine Like "* " & sDec & ":*" 'lead space and lag colon If bIsAMatch Then Exit For 'Test(A:=1, B:=2) bIsAMatch = sLine Like "*(" & sDec & ":*" 'lead opening bracket and lag colon If bIsAMatch Then Exit For 'SomeSub str:=Var bIsAMatch = sLine Like "*:=" & sDec 'lead colon equals and lag nothing If bIsAMatch Then Exit For 'test arg1:=b, arg2:=A + 1 bIsAMatch = sLine Like "*:=" & sDec & " *" 'lead colon equals and lag space If bIsAMatch Then Exit For 'test arg1:=b, arg2:=A(1) + 1 bIsAMatch = sLine Like "*:=" & sDec & "(*" 'lead colon equals and lag opening bracket If bIsAMatch Then Exit For 'SomeSub (str:=Var) bIsAMatch = sLine Like "*:=" & sDec & ")*" 'lead colon equals and lag closing bracket If bIsAMatch Then Exit For 'SomeSub str:=Var, etc bIsAMatch = sLine Like "*:=" & sDec & ",*" 'lead colon equals and lag comma If bIsAMatch Then Exit For 'SomeSub str:=Var.Value etc bIsAMatch = sLine Like "*:=" & sDec & ".*" 'lead colon equals and lag dot If bIsAMatch Then Exit For 'SomeModule.Var.Font.Size = 10 ' bIsAMatch = sLine Like "*." & sDec & ".*" 'lead dot and lag dot ' If bIsAMatch Then Exit For 'SomeModule.Var(2) = 5 ' bIsAMatch = sLine Like "*." & sDec & "(*" 'lead dot and lag opening bracket ' If bIsAMatch Then Exit For 'SomeModule.Var = 3 ' bIsAMatch = sLine Like "*." & sDec & " *" 'lead dot and lag space ' If bIsAMatch Then Exit For Next n If bIsAMatch Then PatternCheck = True 'MsgBox "Match found" Exit Function Else 'MsgBox "No match found" 'Exit Function End If End Function Sub AutoLayout(vA As Variant, Optional bTranspose As Boolean = False) ' Takes array vA of say, 4 columns of data and ' displays on textbox in tabular layout. ' Needs a userform called ViewVars and a textbox ' called Textbox1. Code will adjust layout. ' Transpose2DArr used only to return data to (r, c) format. Dim vB As Variant, vL As Variant, vR As Variant Dim r As Long, c As Long, m As Long, sS As String Dim nNumPadSp As Long, TxtLab As Control, MaxFormWidth As Long Dim sAccum As String, sRowAccum As String, bBold As Boolean Dim nLineLen As Long, BoxFontSize As Long, BoxFontName As String Dim sLabAccum As String, nLabPadSp As Long, oUserForm As Object Dim Backshade As Long, BoxShade As Long, BoxTextShade As Long Dim ButtonShade As Long, ButtonTextShade As Long Dim Lb1 As Long, Ub1 As Long, Lb2 As Long, Ub2 As Long Dim TextLength As Long, bItalic As Boolean ' decide to transpose input or not If bTranspose = True Then Transpose2DArr vA, vR vA = vR End If ' get bounds of display array Lb1 = LBound(vA, 1): Ub1 = UBound(vA, 1) Lb2 = LBound(vA, 2): Ub2 = UBound(vA, 2) ReDim vL(Lb2 To Ub2) ' make labels array ReDim vB(Lb2 To Ub2) ' dimension column width array '-------------------------------------------------------------- ' SET USER OPTIONS HERE '-------------------------------------------------------------- ' set the name of the userform made at design time Set oUserForm = ViewVars ' set limit for form width warning MaxFormWidth = 800 ' make column labels for userform - set empty if not needed vL = Array("Variable", "Procedure", "Module", "Project") ' colors Backshade = RGB(31, 35, 44) 'almost black - used ButtonShade = RGB(0, 128, 128) 'blue-green - not used BoxShade = RGB(0, 100, 0) 'middle green - used ButtonTextShade = RGB(230, 230, 230) 'near white - not used BoxTextShade = RGB(255, 255, 255) 'white - used ' Font details are to be found below '-------------------------------------------------------------- ' find maximum width of array columns ' taking account of label length also For c = Lb2 To Ub2 m = Len(vL(c)) 'label For r = Lb1 To Ub1 sS = vA(r, c) 'value If Len(sS) >= m Then m = Len(sS) End If Next r 'exits with col max array vB(c) = m m = 0 Next c ' For testing only ' shows max value of each column ' For c = LB2 To UB2 ' MsgBox vB(c) ' Next c For r = Lb1 To Ub1 For c = Lb2 To Ub2 If c >= Lb2 And c < Ub2 Then ' get padding for current element nNumPadSp = vB(c) + 2 - Len(vA(r, c)) Else ' get padding for last element nNumPadSp = vB(c) - Len(vA(r, c)) End If ' accumulate line with element padding sAccum = sAccum & vA(r, c) & Space(nNumPadSp) ' get typical line length If r = Lb1 Then sRowAccum = sRowAccum & vA(Lb1, c) & Space(nNumPadSp) nLineLen = Len(sRowAccum) End If Next c ' accumulate line strings sAccum = sAccum & vbNewLine Next r ' accumulate label string For c = Lb2 To Ub2 If c >= Lb2 And c < Ub2 Then ' get padding for current label nLabPadSp = vB(c) + 2 - Len(vL(c)) Else ' get padding for last element nLabPadSp = vB(c) - Len(vL(c)) End If ' accumulate the label line sLabAccum = sLabAccum & vL(c) & Space(nLabPadSp) Next c ' load user form Load oUserForm '================================================================ ' SET FONT DETAILS HERE. THESE AFFECT ALL AUTOSIZING. '================================================================ BoxFontSize = 12 'say between 6 to 20 points bBold = True 'True for bold, False for regular bItalic = False 'True for italics, False for regular BoxFontName = "Courier" 'or other monospaced fonts eg; Consolas '================================================================ ' make the labels textbox Set TxtLab = oUserForm.Controls.Add("Forms.TextBox.1", "TxtLab") ' format the labels textbox With TxtLab .WordWrap = False .AutoSize = True 'extends to fit text .Value = "" .font.Name = BoxFontName .font.SIZE = BoxFontSize .font.Bold = bBold .font.Italic = bItalic .ForeColor = BoxTextShade .Height = 20 .Left = 20 .Top = 15 .Width = 0 .BackStyle = 0 .BorderStyle = 0 .SpecialEffect = 0 End With 'apply string to test label to get length TxtLab.Value = sLabAccum & Space(4) TextLength = TxtLab.Width 'MsgBox TextLength 'format userform With oUserForm .BackColor = Backshade .Width = TextLength + 40 .Height = 340 .Caption = "Redundant variables list..." End With ' check user form is within max width If oUserForm.Width > MaxFormWidth Then MsgBox "Form width is excessive" Unload oUserForm Exit Sub End If 'format the data textbox With oUserForm.TextBox1 .ScrollBars = 3 .WordWrap = True .MultiLine = True .EnterFieldBehavior = 1 .BackColor = BoxShade .font.Name = BoxFontName .font.SIZE = BoxFontSize .font.Bold = bBold .font.Italic = bItalic .ForeColor = BoxTextShade .Height = 250 .Left = 20 .Top = 40 .Width = TextLength .Value = sAccum End With 'show the user form oUserForm.Show End Sub