VBA script to delete rows

[HeyMike]

Hello,

I have a list of about 300,000 company names with 1,000 of them being usable. The usable company names have content in column C. I essentially need to delete any row that does not have content in column C, but I need to keep five rows above and five rows below any company with criteria in column C. Sometimes the criteria in column C is two rows apart, sometimes it is 50,000 rows apart. What is the VBA script for this? Below is a screen shot...

 

[Weaver]

What's the purpose of the rows above & below the 'usable' names? Without this extra criteria, it's a relatively straighforward operation, involving filtering for blanks and then deleting the visible rows.

 

[HeyMike]

Some of the company names are the similar, and I need to keep some of them. For example, YAHOO!, YAHOO Search, YAHOO.COM.

 

[lrobbo314]

Hey, testing this code out seemed to work.

I'd copy your sheet and test it out before I ran it on the source sheet, but like I said I think it's working properly.

Sub del()
On Error GoTo n
Dim x As Integer
Dim r As Range

Set r = Range(Range("B1"), Range("B" & Rows.Count).End(xlUp))
x = r.Rows.Count

For x = x To 1 Step -1

    If WorksheetFunction.CountA(Range(Cells(x - 5, 3), Cells(x + 5, 3))) = 0 Then
        Cells(x, 3).Rows.EntireRow.Delete
    End If

Next x
n:
For x = x To 1 Step -1
    If WorksheetFunction.CountA(Range(Cells(x, 3), Cells(x + 5, 3))) = 0 Then
        Cells(x, 3).Rows.EntireRow.Delete
    End If
Next x

End Sub

 

[HeyMike]

Hey, testing this code out seemed to work.

I'd copy your sheet and test it out before I ran it on the source sheet, but like I said I think it's working properly.

Sub del()
On Error GoTo n
Dim x As Integer
Dim r As Range

Set r = Range(Range("B1"), Range("B" & Rows.Count).End(xlUp))
x = r.Rows.Count

For x = x To 1 Step -1

    If WorksheetFunction.CountA(Range(Cells(x - 5, 3), Cells(x + 5, 3))) = 0 Then
        Cells(x, 3).Rows.EntireRow.Delete
    End If

Next x
n:
For x = x To 1 Step -1
    If WorksheetFunction.CountA(Range(Cells(x, 3), Cells(x + 5, 3))) = 0 Then
        Cells(x, 3).Rows.EntireRow.Delete
    End If
Next x

End Sub

Thanks for the reply! The script worked when I ran a trial but when I run it on my data, I have one issue - the blank cells are not really blank. They come from an IF formula where the output is "". The "" is not a null value and it gets picked up by the VBA script. Can you modify the script to instead of searching for blanks it searches for anything that is ""? Note that it doesn't have to be "", it can be "X" or any value.

 

[lrobbo314]

I can work on it, but I can tell you a quick fix that will make the original code work.

Select the range of information, go to the border of the range until the cursor changes to a cross, click and hold the right mouse button, drag the selection over and then back to it's original position, release the button, and then select "copy as values only". This will make the "" convert to null.

 

[HeyMike]

I can work on it, but I can tell you a quick fix that will make the original code work.

Select the range of information, go to the border of the range until the cursor changes to a cross, click and hold the right mouse button, drag the selection over and then back to it's original position, release the button, and then select "copy as values only". This will make the "" convert to null.

I tried that, but it is still not a null value when you copy and paste as values. The way to test if a cell is a null is with the ISBLANK formula. The function returns a TRUE or FALSE if the cell is null. "" returns a FALSE, and it does the same when it is copy and pasted as values.

 

[lrobbo314]

This code has been edited to go through that range and if the length of the cel is 0 then it will convert the value to null.

Should work after that...

Sub del1()
On Error GoTo n
Dim x As Integer
Dim r As Range

Set r = Range(Range("B1"), Range("B" & Rows.Count).End(xlUp))
Set r = r.Offset(, 1)
x = r.Rows.Count
For Each cel In r
    If Len(cel) = 0 Then cel.Value = vbNullString
Next cel
For x = x To 1 Step -1

    If WorksheetFunction.CountA(Range(Cells(x - 5, 3), Cells(x + 5, 3))) = 0 Then
        Cells(x, 3).Rows.EntireRow.Delete
    End If

Next x
n:
For x = x To 1 Step -1
    If WorksheetFunction.CountA(Range(Cells(x, 3), Cells(x + 5, 3))) = 0 Then
        Cells(x, 3).Rows.EntireRow.Delete
    End If
Next x

End Sub

 

[HeyMike]

This code has been edited to go through that range and if the length of the cel is 0 then it will convert the value to null.

Should work after that...

Sub del1()
On Error GoTo n
Dim x As Integer
Dim r As Range

Set r = Range(Range("B1"), Range("B" & Rows.Count).End(xlUp))
Set r = r.Offset(, 1)
x = r.Rows.Count
For Each cel In r
    If Len(cel) = 0 Then cel.Value = vbNullString
Next cel
For x = x To 1 Step -1

    If WorksheetFunction.CountA(Range(Cells(x - 5, 3), Cells(x + 5, 3))) = 0 Then
        Cells(x, 3).Rows.EntireRow.Delete
    End If

Next x
n:
For x = x To 1 Step -1
    If WorksheetFunction.CountA(Range(Cells(x, 3), Cells(x + 5, 3))) = 0 Then
        Cells(x, 3).Rows.EntireRow.Delete
    End If
Next x

End Sub

Thanks a lot! It worked! It wouldn't do it for all 300K lines at once, so I'm breaking it up into chunks of 25K.

Thanks again!

- Mike

 

[lrobbo314]

Happy to help!