Deleting double-consecutively repeated columns and leaving 4-consecutively repeated column

Does the column need to be sorted before the Macro applies??

For Example -

142321
142321
999999
999999
121421
121421
241424
241424
241424
241424
999999
999999

The 4 999999z are not together, would you still want to delete them??

Thank You,

Deep

Thanks for the reply, and its sorted beforehand so I just need to delete the ones that have 2 consecutive repeats and leave 4 consecutive repeats alone.

And do you want to delete both the Values or Keep one of the Duplicate?

If you want to keep 1 of the duplicate, below is the code -

Sub DeleteDup()

    Dim LR As Integer, Counter As Integer
    
    LR = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    For Counter = 1 To LR
        
       If Application.WorksheetFunction.CountIf(Range("A:A"), Cells(Counter, 1).Value) = 2 Then
        Cells(Counter, 1).EntireRow.Delete
       End If
    
    Next Counter
            
        

End Sub

Thank You,

Deep

You can change the range as per your requirement though.

The code is written only for the A Column.

I've attached the file too.

Thank You,

Deep

Here is the code then, Just 1 line added -

Sub DeleteDup()

    Dim LR As Integer, Counter As Integer
    
    LR = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    For Counter = 1 To LR
        
       If Application.WorksheetFunction.CountIf(Range("A:A"), Cells(Counter, 1).Value) = 2 Then
        Cells(Counter, 1).EntireRow.Delete
        Cells(Counter, 1).EntireRow.Delete
       End If
    
    Next Counter
            
 End Sub

Thank You,

Deep

Hi, Deep,

avoid problems with the counter when deleting by working from the bottom up (otherwise you may miss a couple of rows in the check).

Sub DeleteDup()

Dim lngCounter As Long

For lngCounter = Cells(Rows.Count, 1).End(xlUp).Row - 1 To 1 Step -1
    
  If Application.WorksheetFunction.CountIf(Range("A:A"), Cells(lngCounter, 1).Value) = 2 Then
    Range(Cells(lngCounter - 1, 1), Cells(lngCounter, 1)).EntireRow.Delete
  End If

Next lngCounter
            
End Sub

Ciao,
Holger

Hi, exlgh91,

because you didnīt use code-tags when posting here? (just kidding)

The code will be executed on the active sheet although you want it to execute on a non-active sheet:

Dim longCounter As Long

With Worksheets("MAY 8")
  For longCounter = .Cells(Rows.Count, 1).End(xlUp).Row - 1 To 1 Step -1
    If Application.WorksheetFunction.CountIf(.Range("Q:Q"), .Cells(longCounter, 1).Value) = 2 Then
      .Range(.Cells(longCounter - 1, 1), .Cells(longCounter, 1)).EntireRow.Delete
    End If
  Next longCounter
End With

Ciao,
Holger

Hey Holger!!

I forgot the lesson you taught me a few days back regarding going reverse when it comes to deleting rows..

Ill keep tha in mind..

Cheers!!

Deep