VBA compare two arrays to find elements that don't match, then delete mismatches

Qqqqq

New Member
Joined
Feb 6, 2014
Messages
34
I have several workbooks that contain a lot (3,500+) of old, unused named ranges, and I want to clean these up by deleting the unused names. Some of my used names are constants or formulas, so not all valid names refer to a range of cells in my workbook. There are no names used in other macros, conditional formatting, etc. I thought the best way to find unused names would be to put all the names into an array, and all the workbook data into a second array, then compare the arrays.

What would be the most efficient way to compare the two arrays, and delete items from the first array that are not found in the second? I found an old post by pbornemier with a function that looks like it should do exactly what I need to compare the two arrays, but I get a compile error when I try to use it, so I can't even test to see for sure if it will do what I need. Seeking further wisdom...

This is what I have so far...
Code:
Sub DeleteUnusedNames()[INDENT]    Dim xWB As Workbook:            Set xWB = ActiveWorkbook
[/INDENT]
[INDENT]    Dim xNameCount As Long:         xNameCount = xWB.Names.count
    Dim xArrNames As Variant:       ReDim xArrNames(xWB.Names.count)
    Dim xArrWholeData As Variant:   ReDim xArrWholeData(xWB.Worksheets.count)
    Dim xArrNotUsed As Variant
    Dim xNum As Long                'used for looping through worksheets
    Dim xCount As Long
    
    For xNum = 1 To xWB.Names.count
        [/INDENT]
[INDENT=2]xArrNames(xNum) = xWB.Names(xNum)[/INDENT]
[INDENT]    Next xNum
    
    For xNum = 1 To xWB.Worksheets.count
        [/INDENT]
[INDENT=2]xArrWholeData(xNum) = xWB.Worksheets(xNum).UsedRange.Formula[/INDENT]
[INDENT]    Next xNum


    xArrNotUsed = ReturnItemsNotInA(xArrWholeData, xArrNames)

    xCount = UBound(xArrNotUsed) - LBound(xArrNotUsed) + 1
    
    xArrNotUsed.Delete            [B][COLOR=#0000ff]'Not sure if this will work to delete the names??[/COLOR][/B]
    
    If xCount = 0 Then
        [/INDENT]
[INDENT=2]MsgBox "No unused named ranges were found in this workbook", vbOKOnly, "No unused names were found"[/INDENT]
[INDENT]    Else
        [/INDENT]
[INDENT=2]MsgBox xCount & " named ranges were deleted", vbOKOnly, "Unused names were deleted"[/INDENT]
[INDENT]    End If
[/INDENT]

End Sub


pbornemier's function
Code:
Function ReturnItemsNotInA(aryA As Variant, aryB As Variant) As Variant  

'   [URL]https://www.mrexcel.com/forum/excel-questions/959337-vba-looping-through-two-arrays-find-entries-dont-match.html[/URL][INDENT]
[/INDENT]

'Receive 2 arrays, compare & return list of items in B not in A
'Modify code depending on how arrays were generated
'If 2D with dimensions (1 to Count, 1 to 1) use (xIndex, 1)
'If 1D with dimension  (1 to Count)         use (xIndex)[INDENT]
    Dim xSD As Object
    Dim xIndex As Long
    Dim xKey  As Variant
    
    Set xSD = CreateObject("Scripting.Dictionary")
    
    With xSD
        [/INDENT]
[INDENT=2]'Array B
        For xIndex = LBound(aryB) To UBound(aryB)
[/INDENT]
[INDENT=3].Item(aryB(xIndex)) = .Item(aryB(xIndex)) + 1[/INDENT]
[INDENT=2]        Next
        
'Remove items from Array A that are also in Array B
        [/INDENT]
[INDENT=2]For xIndex = LBound(aryA) To UBound(aryA)[/INDENT]
[INDENT=3]If .Exists(aryA(xIndex, 1)) Then .Remove (aryA(xIndex, 1))      [B][COLOR=#0000ff]'Run-time error '9': Subscript our of range[/COLOR][/B][/INDENT]
[INDENT=2]        Next
        [/INDENT]
[INDENT=2]
'Get Scripting.Dictionary data to array
[/INDENT]
[INDENT=2]If .count > 0 Then
[/INDENT]
[INDENT=3]xKey = .Keys[/INDENT]
[INDENT=2]End If[/INDENT]
[INDENT]    End With
    
    ReturnItemsNotInA = xKey
    
    Set xSD = Nothing[/INDENT]

End Function
Actually, it looks like the Scripting Dictionary is only getting 256 items from aryB, so I'm not sure the function will work for me at all. ... Any other ideas?
 
Last edited:

Some videos you may like

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
16,836
Office Version
2010
Platform
Windows
Haven't looked at all your code, but this:
Code:
[INDENT] For xNum = 1 To xWB.Worksheets.count[/INDENT]
[INDENT=2]xArrWholeData(xNum) = xWB.Worksheets(xNum).UsedRange.Formula[/INDENT]
[INDENT]    Next xNum
is most likely producing a 2-D array with an upper bound on the 2nd dimension > 1, while the function 'ReturnItemsNotInA' doesn't appear to handle that case as the author makes clear in the comments just below the Function .... line.
[/INDENT]
 

Qqqqq

New Member
Joined
Feb 6, 2014
Messages
34
is most likely producing a 2-D array with an upper bound on the 2nd dimension > 1, while the function 'ReturnItemsNotInA' doesn't appear to handle that case
How would I go about modifying the code to accommodate a 2-D array with an upper bound on the 2nd dimension?
 

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
16,836
Office Version
2010
Platform
Windows
How would I go about modifying the code to accommodate a 2-D array with an upper bound on the 2nd dimension?
Maybe something like this:
Code:
'Remove items from Array A that are also in Array B
Dim xIndex2 As Long
For xIndex = LBound(aryA, 1) To UBound(aryA, 1)
    For xIndex2 = LBound(aryA, 2) To UBound(aryA, 2)
        If .Exists(aryA(xIndex, xIndex2)) Then .Remove (aryA(xIndex, xIndex2))      'Run-time error '9': Subscript our of range
    Next xIndex2
Next xIndex
There are other issues you will have to address too. For example, when a name is used in a formula in a worksheet cell, adding the Cell.Formula to your array produces a string that includes "=", the name, and often other sub-strings. Your code will have to extract the name for a direct comparison to aryB which holds just the name.
 

Watch MrExcel Video

Forum statistics

Threads
1,099,247
Messages
5,467,512
Members
406,543
Latest member
margram

This Week's Hot Topics

Top