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

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

Hi, exlgh91,

Cells wants the Row first and the Column thereafter either being noted as a string or as the Column number. A is 1 so you were checking the wrong column for the dupes. And I should have noticed that checking Column Q with a value from Column A doesnīt make that much sense.

This code will check for Column B, if you want it to work on any other column just change the value of the Constant cstrCOL.

Sub Delete2()

Dim lngCounter As Long

Const cstrCOL As String = "B"

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

Ciao,
Holger

Hi, exlgh91,

the code was exclusively looking for doubled lines by using WorksheetFunction.CountIf(..) = 2. If you want it changed the code must be altered as the lines to delete could interfere with other existing lines which should not be deleted.

Maybe you go have a go with

Sub Delete3()

Dim lngCounter As Long

Const cstrCOL As String = "B"

For lngCounter = Cells(Rows.Count, cstrCOL).End(xlUp).Row To 2 Step -1
    Select Case WorksheetFunction.CountIf(Range(Cells(1, cstrCOL), Cells(Rows.Count, cstrCOL)), Cells(lngCounter, cstrCOL).Value)
      Case 1
        Cells(lngCounter, cstrCOL).EntireRow.Delete
      Case 2
        Range(Cells(lngCounter - 1, cstrCOL), Cells(lngCounter, cstrCOL)).EntireRow.Delete
      Case 3
        Range(Cells(lngCounter - 2, cstrCOL), Cells(lngCounter, cstrCOL)).EntireRow.Delete
      Case Else
        'do nothing
    End Select
Next lngCounter
End Sub

Ciao,
Holger