Find "single row" and delete them

Hi everyone,
I am pretty new to Excel - but I have a little programming experience.
Anyway, I am stuck and could need help.

I tried to write a script that does following:


I have data that looks like this:

1
1
2
2
3
3
4
5
5
6
6

As you can see, mostly every two rows contain same values.
But there are some values (here it is 4) that is a "single row".

I want to find every "single row" and delete them.
I tried a long time but reached frustration now
I hope someone can help me.
My script is below.
Thank You!

Sub DeleteFalse()

    Set xRng = Selection
    xCount = xRng.Rows.Count
    Dim blDimensioned As Boolean
    Dim myArray() As Integer
    Dim arrayCounter As Integer
    Dim s As Integer
    arrayCounter = 0
    s = 0
    
    blDimensioned = False
        For i = 3 To xCount
            If blDimensioned = True Then
                If xRng.Cells(i, 1) = xRng.Cells(i + 1, 1) Then
                    s = 2
                Else
                    ReDim Preserve myArray(UBound(myArray) + 1)
                    myArray(arrayCounter) = i
                    arrayCounter = arrayCounter + 1
                    s = 1
                End If
            Else
                If xRng.Cells(i, 1) = xRng.Cells(i + 1, 1) Then
                    s = 2
                Else
                    ReDim myArray(0 To 0) As Integer
                    myArray(arrayCounter) = i
                    blDimensioned = True
                    arrayCounter = arrayCounter + 1
                    s = 1
                End If
            End If
        i = i + s
        Next i
        
'        For i = 0 To UBound(myArray)
'            xRng.Cells(i + 1, "e").FormulaArray = "raus"
'        Next i

        For i = 0 To UBound(myArray)
            xRng.Cells(myArray(i)).EntireRow.Delete
        Next i
End Sub

Hello jk@CU,

Here is version similar to yours. The Dictionary object is an Associative Array. This makes it faster and easier to reference the elements because of the Exists method. This will tell you if an element is already in the array. The additional advantage over a regular array is the index or "key" can be any of any data type as can the contents or "item" except a User Define Type.

Sub DeleteUniques()

  Dim Cell As Range
  Dim DSO As Object
  Dim Item As Variant
  Dim Items As Variant
  Dim Key As Variant
  Dim Rng As Range
  
    Set Rng = Selection.Resize(ColumnSize:=1)
    Set DSO = CreateObject("Scripting.Dictionary")
    DSO.CompareMode = vbTextCompare
    
      For Each Cell In Rng
        Key = Trim(Cell.Value)
        If Key <> "" Then
          If Not DSO.Exists(Key) Then
            DSO.Add Key, Cell
          Else
            DSO(Key) = ""
          End If
        End If
      Next Cell
     
     Items = DSO.Items
     Set Rng = Nothing
     
     For Each Item In Items
       If Item <> "" Then
         If Rng Is Nothing Then Set Rng = Item
         Set Rng = Union(Rng, Item)
       End If
     Next Item
     
     If Not Rng Is Nothing Then Rng.EntireRow.Delete
     
  Set DSO = Nothing
    
End Sub

Hi Leith and everyone,

Sadly I recognized, that that macro makes some kind of mistake
1.) It does not delete every "single-value-row"
2.) However it seems to delete too many rows
3.) I could not apply that macro to a selection of a huge number of rows
(e.g. 4000)

I will definitely work on a solution - If someone else is interested to do so before I would be very grateful

I will attach an excel file (without the two macro-versions above).
It contains two columns, the first is the "ID" of a person (here person 13 and 14), the second column contains the values I would like to filter for.

Best, Johann

I just used a minor variation of Leith's code on 10,000 rows, and it worked perfectly. Post a workbook where it doesn't work.

Hello jk@CU,

Please post examples that represent to the ACTUAL data layout and format. The macro works as it should. The problem is you failed to mention that another variable Var1 needed to be considered. I discovered this after manually examining all the cells you wanted to check. I will post back with a macro that takes this new variable into consideration.