Results 1 to 4 of 4

Thread: VBA compare two arrays to find elements that don't match, then delete mismatches
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Feb 2014
    Location
    Sunshine State
    Posts
    34
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

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

    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()
    Dim xWB As Workbook: Set xWB = ActiveWorkbook
    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
    xArrNames(xNum) = xWB.Names(xNum)
    Next xNum For xNum = 1 To xWB.Worksheets.count
    xArrWholeData(xNum) = xWB.Worksheets(xNum).UsedRange.Formula
    Next xNum xArrNotUsed = ReturnItemsNotInA(xArrWholeData, xArrNames) xCount = UBound(xArrNotUsed) - LBound(xArrNotUsed) + 1 xArrNotUsed.Delete 'Not sure if this will work to delete the names?? If xCount = 0 Then
    MsgBox "No unused named ranges were found in this workbook", vbOKOnly, "No unused names were found"
    Else
    MsgBox xCount & " named ranges were deleted", vbOKOnly, "Unused names were deleted"
    End If
    End Sub


    pbornemier's function
    Code:
    Function ReturnItemsNotInA(aryA As Variant, aryB As Variant) As Variant  
    
    '   https://www.mrexcel.com/forum/excel-...ont-match.html
    '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)
    Dim xSD As Object Dim xIndex As Long Dim xKey As Variant Set xSD = CreateObject("Scripting.Dictionary") With xSD
    'Array B For xIndex = LBound(aryB) To UBound(aryB)
    .Item(aryB(xIndex)) = .Item(aryB(xIndex)) + 1
    Next 'Remove items from Array A that are also in Array B
    For xIndex = LBound(aryA) To UBound(aryA)
    If .Exists(aryA(xIndex, 1)) Then .Remove (aryA(xIndex, 1)) 'Run-time error '9': Subscript our of range
    Next
    'Get Scripting.Dictionary data to array
    If .count > 0 Then
    xKey = .Keys
    End If
    End With ReturnItemsNotInA = xKey Set xSD = Nothing
    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 by Qqqqq; May 31st, 2019 at 01:53 PM.

  2. #2
    MrExcel MVP
    Join Date
    May 2009
    Posts
    16,218
    Post Thanks / Like
    Mentioned
    35 Post(s)
    Tagged
    8 Thread(s)

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

    Haven't looked at all your code, but this:
    Code:
    For xNum = 1 To xWB.Worksheets.count
    xArrWholeData(xNum) = xWB.Worksheets(xNum).UsedRange.Formula
    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.
    Joe

    When I was a young man I knew everything. Now that I'm older, I realize I know very little, and what I do know, I tend to forget!

  3. #3
    New Member
    Join Date
    Feb 2014
    Location
    Sunshine State
    Posts
    34
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

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

    Quote Originally Posted by JoeMo View Post
    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?

  4. #4
    MrExcel MVP
    Join Date
    May 2009
    Posts
    16,218
    Post Thanks / Like
    Mentioned
    35 Post(s)
    Tagged
    8 Thread(s)

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

    Quote Originally Posted by Qqqqq View Post
    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.
    Joe

    When I was a young man I knew everything. Now that I'm older, I realize I know very little, and what I do know, I tend to forget!

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •