Deleting an item from middle of an array in vba-CodePudding

Deleting an item from middle of an array in vba

I am looping through two arrays to look for which item in Arr1 is equal to Arr2. Then I want to delete that item from Arr1. At the end I will add that Arr1 to Arr2. So, it's somehow detecting if Arr1 has new item that is not in Arr2, and add that item to Arr2

Public Sub cmpArr()

For i =LBound(Arr1) To UBound(Arr2)
    For j = LBound(Arr2) To UBound(Arr2)
         If Arr1(i) = Arr2(j) Then
            'Arr1(i) delete
         End If
    Next j
Next i

End Sub

User braX suggested to use dictionaries. On his advice, I changed using arrays to using dictionaries. Here's code

Public Sub comp_2Dictnries()
   For i =0 To dict1.Count -1 
      For j=0 To dict2.Count -1
          On Error Resume Next
          If dict1.Items()(i) =dict2.Items()(j) Then
             dict1.Remove dict1.Keys()(i)
          End If
      Next j
   Next i
End Sub

CodePudding user response：

Please, try the next way:

Sub replaceArrayElem()
  Dim arr1, arr2, arr3, mtch, i As Long, j As Long
  arr1 = Array("a", "c", "d", "jj", "t", "www")
  arr2 = Array("m", "r", "o", "c", "uu", "n", "d")
  For i = LBound(arr2) To UBound(arr2)
        mtch = Application.match(arr2(i), arr1, 0)
        If IsNumeric(mtch) Then 'if a match exists
            arr1(mtch - 1) = "#$@!": arr1 = filter(arr1, "#$@!", False) 'filter eliminate a specific element
        End If
  Next i
  Debug.Print Join(arr1, ",") ' just to visually see how arr1 remained
  arr3 = arr2: ReDim Preserve arr3(UBound(arr2)   UBound(arr1)   1)
  For i = UBound(arr2)   1 To UBound(arr3)
       arr3(i) = arr1(j): j = j   1
  Next i
  Debug.Print Join(arr3, ",") 'the returned array...
End Sub

Please, send some feedback after testing it.

And a version using a Scripting.Dictionary (if you have the arrays, or like working with them):

Sub replaceArrayElemDict()
  Dim arr1, arr2, arr3, mtch, i As Long, j As Long
  Dim dict As Object
  
  arr1 = Array("a", "c", "d", "jj", "t", "www")
  arr2 = Array("m", "r", "o", "c", "uu", "n", "d")
  
  Set dict = CreateObject("Scripting.Dictionary")
  For i = LBound(arr2) To UBound(arr2)
        dict(arr2(i)) = vbNullString
  Next i
  For i = LBound(arr1) To UBound(arr1)
        dict(arr1(i)) = vbNullString 'it creates a NEW dictionary key only if it does not exist...
  Next i
  
  Debug.Print Join(dict.Keys, ",") 'the returned array...
End Sub