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

[Qqqqq]

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...

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

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?

 

[JoeMo]

Haven't looked at all your code, but this:

[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]

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]

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:

'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.