Find/Delete value from unique array

IREALLYambatman

Board Regular
Joined
Aug 31, 2016
Messages
63
My Idea: Hey Guys, so I have a Row of data, with a bunch of Sample ID's in them. I add all those values from a row into an array, then only keep the unique ones. Now I want VBA to search the array for the values in the array, if there's a match, then deletes the value from the array and also does other stuff. Since it deletes the value from the Array then the second time that value occurs, the value will not be found in the unique array.

Example Data:
[TABLE="width: 500"]
<tbody>[TR]
[TD]A
[/TD]
[TD]C
[/TD]
[TD]A
[/TD]
[/TR]
[TR]
[TD]First Occurance, delete "A" from unique array, and also do stuff
[/TD]
[TD]First Occurance, delete "A" from unique array, and also do stuff
[/TD]
[TD] Value shouldn't be found in unique array, so not first occurance, do nothing.
[/TD]
[/TR]
</tbody>[/TABLE]

My (mostly from forums) code:
Code:
Dim ArrayOfSampleIDs() As Variant
Dim UniqueArrayOfSampleIDs() As Variant
Dim i As Long

ReDim ArrayOfSampleIDs(3 To LastCol)

For i = 3 To LastCol
    ArrayOfSampleIDs(i) = Cells(11, i).value ' Array Of ALL sample ID's
Next

UniqueArrayOfSampleIDs = RemoveDupes(ArrayOfSampleIDs) ' Array Of UNIQUE sample ID's
 
For i = 3 To LastCol
      IsInArray = (UBound(Filter(UniqueArrayOfSampleIDs, Cells(11, i).value)) > -1)
      If IsInArray Then

      'Delete This Value From Array(UniqueArrayOfSampleIDs, Cells(11, i).value)     [U][I][B]  <------- Need Help Here (this is obviously not a real function)[/B][/I][/U]

      'Do Otherstuff (this is ready to go)
      
      End If
      
Next i

Function RemoveDupes(InputArray As Variant) As Variant
  Dim X As Long
  With CreateObject("Scripting.Dictionary")
    For X = LBound(InputArray) To UBound(InputArray)
      If Not IsMissing(InputArray(X)) Then .Item(InputArray(X)) = 1
    Next
    RemoveDupes = .Keys
  End With
End Function
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
If you are interested, with the following you can store the unique values ​​in an array.

Code:
Sub Test()
    Dim i As Long, ky As Variant
    With CreateObject("scripting.dictionary")
      For i = 3 To Cells(11, Columns.Count).End(xlToLeft).Column
        .Item(Cells(11, i).Value) = Empty
      Next
      For Each ky In .Keys
        MsgBox "Unique value: " & ky
      Next ky
    End With
End Sub
 
Upvote 0
If you are interested, with the following you can store the unique values ​​in an array.

Code:
Sub Test()
    Dim i As Long, ky As Variant
    With CreateObject("scripting.dictionary")
      For i = 3 To Cells(11, Columns.Count).End(xlToLeft).Column
        .Item(Cells(11, i).Value) = Empty
      Next
      For Each ky In .Keys
        MsgBox "Unique value: " & ky
      Next ky
    End With
End Sub

Dante, that part is already working(though your code is more concise). The part I'm stuck in is searching the array values and deleting the value I want to delete from the array... aka If i have A, B, C, D in an array, and I want to delete D in the array. I can't figure out how to do that.
 
Upvote 0
I don't understand, why do you want to delete a duplicate. The most practical: Do not load duplicates in the array.


I give you an example to delete a data in the array.


<table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td><td >F</td><td >G</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >9</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >10</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >11</td><td > </td><td > </td><td >data1</td><td >data2</td><td >data3</td><td >data4</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >12</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr></table>



Code:
[COLOR=#0000ff]Sub test2()[/COLOR]
  Dim dict As New Scripting.Dictionary
  Dim i As Long, ky
  'load dict
  For i = 3 To Cells(11, Columns.Count).End(xlToLeft).Column
    dict.Add Key:=Cells(11, i).Text, Item:=Cells(11, i).Text 'the key and item is the same
  Next
  
  'for example delete data3
  dict.Remove "data3"   'make reference to the key "data3"
  For Each ky In dict.Keys
    MsgBox "key : " & ky
  Next
End Sub


[COLOR=#ff0000]Sub test3()[/COLOR]
  Dim dict As New Scripting.Dictionary
  Dim i As Long, it
  'load dict
  For i = 3 To Cells(11, Columns.Count).End(xlToLeft).Column
    dict.Add Key:=i, Item:=Cells(11, i).Text 'the key is the column number and the item is the cell value
  Next
  
  'for example delete data3
  dict.Remove 5   'make reference to the key column 5
  For Each it In dict.Items
    MsgBox "item : " & it
  Next
End Sub

Note: How to Add a Reference to the Microsoft Scripting Runtime
Go to "Tools" and click "References." This opens the References dialog box.
Scroll down the list and put a check next to "Microsoft Scripting Runtime."
 
Upvote 0
Hey Dante, you are misunderstanding me.. I have an array with all the unique values, A, B, C, D, E.. Then I want to SEARCH that array with a string, "X". If it's found, I want to delete it. I just realized that it was far easier to set the value of the element in the array to "" instead of deleting it.

Just in case someone else is in the same boat as me, I fixed it by doing this:
Code:
Dim ArrayOfSampleIDs() As Variant
Dim UniqueArrayOfSampleIDs() As Variant
Dim i As Long

ReDim ArrayOfSampleIDs(3 To LastCol)

For i = 3 To LastCol
    ArrayOfSampleIDs(i) = Cells(11, i).value ' Array Of ALL sample ID's
Next

UniqueArrayOfSampleIDs = RemoveDupes(ArrayOfSampleIDs) ' Array Of UNIQUE sample ID's

 
For i = 3 To LastCol
      IsInArray = (UBound(Filter(UniqueArrayOfSampleIDs, Cells(11, i).value)) > -1)
      
      If IsInArray Then
                  Dim Location As Variant
                  Location = WhereInArray(UniqueArrayOfSampleIDs, Cells(11, i).value) 
                  If IsNull(Location) = True Then ' Testing to see if the search match is exact.  
                  'Do Something
                  Else
                  UniqueArrayOfSampleIDs(Location) = ""    'Delete the Value from array
                    End If
                    
      End If
Next i
 
Last edited:
Upvote 0
Sorry for that, I don't understand what you needed, I got confused because your function is called "RemoveDupes".
I'm glad to hear you solved it. Good luck
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,176
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top