Macro to to Delete every 4th Row in Column J where there is text

[howard]

I have have a formula in Col J below from row 2 onwards

=IF(I2="","",A2)

Where Col J from row 2 onwards contains Text, I need code to find the first text that is not blank and to delete this text as well as every 4th after finding the first text

Macro or Formula to Delete Duplicated Ref Numbers whee Branch is the Same. Ver 1.1xlsm.xlsm
	J
1	Division
2
3
4
5
6
7
8	South End
9	South End
10	Mayberry
11	South End
12	South End
13	Port Edward
14
15
16
17
Duplicates

Cell Formulas
Range	Formula
J2:J17	J2	=IF(I2="","",A2)

In the example above rows 8 & 11 to be deleted

It would be appreciated if someone could assist me

 

[JoeMo]

Your post is a bit confusing as to whether you want to delete the text in specific cells or delete the rows the specific cells are in. Assuming you want to delete the text not the rows, the code below should do that. Please note that col J cells initially hold formulas, deleting the text will remove those formulas with no undo available, so try this on a copy of your sheet.

Sub DeleteTextIf()
Dim V As Variant, i As Long, Ct1 As Long, x As Long
V = Range("J2:J17").Value  'Expand range to suit
Application.ScreenUpdating = False
For i = LBound(V, 1) To UBound(V, 1)
    If V(i, 1) <> "" Then
        If Ct1 = 0 Then
            Ct1 = i + 1
            x = Ct1 Mod 3
            Cells(Ct1, "J").Value = "#N/A"
        Else
            If (i + 1) Mod 3 = x Then Cells(i + 1, "J").Value = "#N/A"
        End If
    End If
Next i
On Error Resume Next
Range("J2:J17").SpecialCells(xlCellTypeConstants, xlErrors).ClearContents
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

 

[howard]

Thanks for the help.

I have written a macro to range value the items in ColJ. Kindly amend you code to find the first Text , delete this row and thereafter every 4th row after find the first text

Macro to find Text & Delete Every 4th Items thereafrer in Col C every 1st triplicate IOtem).xlsm
	I	J
1	Triplicate	Division
2
3
4
5
6
7
8	Delete	BR Bay West
9	Delete	BR Bay West
10	Delete	BR South Coast
11		BR Bay West
12	Delete	BR Bay West
13	Delete	BR South Coast
14
15
16
17
Duplicates

 

[JoeMo]

Your example appears to want deletion of more than every 4th row. See if this is what you want. If you don't want entire rows deleted, see the comment on the line that deletes.

Sub DeleteCertainRows()
Dim V As Variant, i As Long, Ct1 As Long, x As Long
V = Range("J2:J17").Value  'Expand range to suit
Application.ScreenUpdating = False
For i = LBound(V, 1) To UBound(V, 1)
    If Ct1 > 0 Then GoTo Nx
    If V(i, 1) <> "" Then
        Ct1 = i + 1
        x = Ct1 Mod 3
        Cells(Ct1, "J").Value = "#N/A"
    End If
Nx:
    If (i + 1) Mod 3 = x Then Cells(i + 1, "J").Value = "#N/A"
Next i
On Error Resume Next
Range("J2:J17").SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete 'change to .Delete shift:= xlup if don't want entire rows deleted
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

 

[howard]

Thanks for the help, Joe

 

[JoeMo]

Thanks for the help, Joe

You are welcome - thanks for the reply.