Excel delete rows if Cell D contains ("Text") and Cell F isBlank delete row

fatpierre · Mar 20th 2019

Having a very basic knowledge of VBA I am trying to create a macro that will delete rows if Cell d contains ("Text") and Cell f isBlank delete row
Got as far as

Code

[FONT=courier new]Sub DeleteRowsWithText()
Dim c As Range
Dim SrchRng


Set SrchRng = ActiveSheet.Range("D2", ActiveSheet.Range("D2000").End(xlUp))
Do
Set c = SrchRng.Find("AFC", LookIn:=xlValues)
If Not c Is Nothing Then c.EntireRow.Delete
Loop While Not c Is Nothing[/FONT]


[FONT=courier new]End Sub[/FONT]

Display More

But I need it to check the data in Column F to see if it blank before deleting the row

Sample [TABLE="border: 0, cellpadding: 0, cellspacing: 0"]

[tr]

[TD="width: 75"]A[/TD]
[TD="width: 75"]B[/TD]
[TD="width: 127"]C[/TD]
[TD="width: 97"]D[/TD]
[TD="width: 77"]E[/TD]
[TD="width: 120"]F[/TD]

[/tr]

[tr]

[TD="align: right"]3528[/TD]
[TD="align: right"]3528[/TD]
[TD="class: xl65, align: right"]12/03/2019 20:24[/TD]

[td]

D2010

[/td]

[td]

Booked

[/td]

[td]

Booked

[/td]

[/tr]

[tr]

[TD="align: right"]3528[/TD]
[TD="align: right"]3528[/TD]
[TD="class: xl65, align: right"]12/03/2019 20:28[/TD]

[td]

MSG101

[/td]

[td]

Email

[/td]

[td]

Message

[/td]

[/tr]

[tr]

[TD="align: right"]495[/TD]
[TD="align: right"]495[/TD]
[TD="class: xl65, align: right"]12/03/2019 20:32[/TD]

[td]

MSG101

[/td]

[td]

Email

[/td]

[td]

Message

[/td]

[/tr]

[tr]

[TD="align: right"]790[/TD]
[TD="align: right"]790[/TD]
[TD="class: xl65, align: right"]12/03/2019 20:46[/TD]

[td]

CTD

[/td]

[td]

Phone

[/td]

[td]

Number

[/td]

[/tr]

[tr]

[TD="align: right"]790[/TD]
[TD="align: right"]790[/TD]
[TD="class: xl65, align: right"]12/03/2019 20:46[/TD]

[td]

AFC

[/td]

[td]

Auto

[/td]

[td][/td]

[/tr]

[tr]

[TD="align: right"]108[/TD]
[TD="align: right"]108[/TD]
[TD="class: xl65, align: right"]12/03/2019 20:56[/TD]

[td]

MSG101

[/td]

[td]

Email

[/td]

[td]

Message

[/td]

[/tr]

[tr]

[TD="align: right"]1918[/TD]
[TD="align: right"]1918[/TD]
[TD="class: xl65, align: right"]12/03/2019 20:59[/TD]

[td]

MSG101

[/td]

[td]

Email

[/td]

[td]

Message

[/td]

[/tr]

[tr]

[TD="align: right"]1918[/TD]
[TD="align: right"]1918[/TD]
[TD="class: xl65, align: right"]12/03/2019 21:00[/TD]

[td]

MSG101

[/td]

[td]

Email

[/td]

[td]

Message

[/td]

[/tr]

[tr]

[TD="align: right"]1973[/TD]
[TD="align: right"]1973[/TD]
[TD="class: xl65, align: right"]12/03/2019 21:06[/TD]

[td]

CTD

[/td]

[td]

Phone

[/td]

[td]

Number

[/td]

[/tr]

[tr]

[TD="align: right"]2096[/TD]
[TD="align: right"]2096[/TD]
[TD="class: xl65, align: right"]12/03/2019 21:07[/TD]

[td]

MSG101

[/td]

[td]

Email

[/td]

[td]

Message

[/td]

[/tr]

[tr]

[TD="align: right"]1973[/TD]
[TD="align: right"]1973[/TD]
[TD="class: xl65, align: right"]12/03/2019 21:11[/TD]

[td]

CTD

[/td]

[td]

Phone

[/td]

[td]

Number

[/td]

[/tr]

[tr]

[TD="align: right"]1973[/TD]
[TD="align: right"]1973[/TD]
[TD="class: xl65, align: right"]12/03/2019 21:14[/TD]

[td]

AFC

[/td]

[td]

Auto

[/td]

[td]

Completed

[/td]

[/tr]

[tr]

[TD="align: right"]2169[/TD]
[TD="align: right"]2169[/TD]
[TD="class: xl65, align: right"]12/03/2019 21:22[/TD]

[td]

MSG101

[/td]

[td]

Email

[/td]

[td]

Message

[/td]

[/tr]

[tr]

[TD="align: right"]2169[/TD]
[TD="align: right"]2169[/TD]
[TD="class: xl65, align: right"]12/03/2019 22:01[/TD]

[td]

MSG101

[/td]

[td][/td]

[td]

Message

[/td]

[/tr]

[tr]

[TD="align: right"]1324[/TD]
[TD="align: right"]1324[/TD]
[TD="class: xl65, align: right"]12/03/2019 22:22[/TD]

[td]

CTD

[/td]

[td]

Phone

[/td]

[td]

Number

[/td]

[/tr]

[tr]

[TD="align: right"]1324[/TD]
[TD="align: right"]1324[/TD]
[TD="class: xl65, align: right"]12/03/2019 22:25[/TD]

[td]

AFC

[/td]

[td]

Auto

[/td]

[td]

Completed

[/td]

[/tr]

[tr]

[TD="align: right"]265[/TD]
[TD="align: right"]265[/TD]
[TD="class: xl65, align: right"]12/03/2019 23:01[/TD]

[td]

CTD

[/td]

[td]

Phone

[/td]

[td]

Number

[/td]

[/tr]

[tr]

[TD="align: right"]265[/TD]
[TD="align: right"]265[/TD]
[TD="class: xl65, align: right"]12/03/2019 23:02[/TD]

[td]

AFC

[/td]

[td]

Auto

[/td]

[td]

Completed

[/td]

[/tr]

[/TABLE]
Any thoughts please would be great

Maqbool · Mar 21st 2019

Hi

try the below :

Code

Sub Test()
Dim wsOne As Worksheet
Dim rngOne As Range
Dim testOne As String
Dim testTwo As String


Set wsOne = ThisWorkbook.Sheets("Sheet1")


With wsOne
    x = .Rows.Count
    Set rngOne = .Range("F2", .Range("F" & x).End(xlUp))
End With


With rngOne
    n = rngOne.Count
    For x = n To 1 Step -1
        testOne = .Cells(x, 1).Value
        testTwo = .Cells(x, -1).Value
        Debug.Print testOne
        If testOne = "" And testTwo = "AFC" Then
            .Cells(x, -1).Font.Bold = True  'this will highlight the cell which is going to be deleted
            '.Cells(x, -1).EntireRow.Delete 'to delete entire row - enable this part, if everything works as expected
        End If
    Next
End With




End Sub

Display More

Regards

Maqbool

**KjBox** · Mar 21st 2019

An alternative method which will be faster, especially if dataset is large

Code

Sub DeleteRows()
    Dim x, i As Long
    
    With ActiveSheet.Cells(1).CurrentRegion
        x = .Value
        For i = 1 To UBound(x, 1)
            If x(i, 4) = "AFC" And x(i, 6) = "" Then x(i, 4) = ""
        Next
        .Value = x
        .Columns(4).SpecialCells(4).EntireRow.Delete
    End With
    
End Sub

Display More

Excel delete rows if Cell D contains ("Text") and Cell F isBlank delete row

Participate now!

Share