Delete rows based on a particular text in a cell

[manojrf]

Hi, I don't know how to make macros. I would like to get some help from anyone who knows how to make them.

I have a sheet that has data of about 26000 rows and about 15 columns. It contains numbers and texts. I need to delete the rows that contain a particular text,so that the file size becomes less. In my case, the text is 'CLOSED' in column 'F'. My sheet's name is 'FILE'.

Can anyone help me ?

Thanking you in advance

Manuel George

 

[VoG]

Hi. Try this

Sub DelRows()
Dim LR As Long, i As Long
Application.ScreenUpdating = False
With Sheets("FILE")
    LR = .Range("F" & Rows.Count).End(xlUp).Row
    For i = LR To 1 Step -1
        If .Range("F" & i).Value = "CLOSED" Then .Rows(i).Delete
    Next i
End With
Application.ScreenUpdating = True
End Sub

 

[manojrf]

Hi. Try this

Sub DelRows()
Dim LR As Long, i As Long
Application.ScreenUpdating = False
With Sheets("FILE")
    LR = .Range("F" & Rows.Count).End(xlUp).Row
    For i = LR To 1 Step -1
        If .Range("F" & i).Value = "CLOSED" Then .Rows(i).Delete
    Next i
End With
Application.ScreenUpdating = True
End Sub

Hi,

Thank you so much . This works fine. But it takes more time. In my case I have about 9000 rows to get deleted. It takes about 3-4 minutes. Is there anyway I can make the time shorter , in other word faster ?

Thank you. Manuel

 

[mirabeau]

You can try this one. It may not leave your formats unaltered though. If you want to retain any formatting, can give modified code that shouldn't take longer.

Sub delrow()
Dim nr&, nc&, a, i&, j&, u()
Sheets("FILE").Activate
nr = Cells.Find("*", after:=Range("A1"), searchorder:=xlByRows, _
    searchdirection:=xlPrevious).Row
nc = Cells.Find("*", after:=Range("A1"), searchorder:=xlByColumns, _
    searchdirection:=xlPrevious).Column
ReDim u(1 To nr, 1 To nc)
a = Cells(1).Resize(nr, nc)
Cells(1).Resize(nr, nc).ClearContents
For i = 1 To nr
    If InStr(a(i, 6), "CLOSED") = 0 Then
     k = k + 1
     For j = 1 To nc
        u(k, j) = a(i, j)
    Next j
    End If
Next i
Cells(1).Resize(k, nc) = u
End Sub

 

[manojrf]

You can try this one. It may not leave your formats unaltered though. If you want to retain any formatting, can give modified code that shouldn't take longer.

Sub delrow()
Dim nr&, nc&, a, i&, j&, u()
Sheets("FILE").Activate
nr = Cells.Find("*", after:=Range("A1"), searchorder:=xlByRows, _
    searchdirection:=xlPrevious).Row
nc = Cells.Find("*", after:=Range("A1"), searchorder:=xlByColumns, _
    searchdirection:=xlPrevious).Column
ReDim u(1 To nr, 1 To nc)
a = Cells(1).Resize(nr, nc)
Cells(1).Resize(nr, nc).ClearContents
For i = 1 To nr
    If InStr(a(i, 6), "CLOSED") = 0 Then
     k = k + 1
     For j = 1 To nc
        u(k, j) = a(i, j)
    Next j
    End If
Next i
Cells(1).Resize(k, nc) = u
End Sub

Hi,

When I tried to run this macro, an error message - 'Runtime error 6 - Overflow' , pops up and when i debug it, the line 'a = Cells(1).Resize(nr, nc)' in your macro code, gets highlighted. Can you please correct it ?

Thank you. Manuel George

 

[mirabeau]

When I tried to run this macro, an error message - 'Runtime error 6 - Overflow' , pops up and when i debug it, the line 'a = Cells(1).Resize(nr, nc)' in your macro code, gets highlighted. Can you please correct it ?

That error would usually arise if one or more of the variables were declared inappropriately. Such as declaring a variable as Integer when it is numerically larger than the integer size, that is, falling outside the range -32,768 to 32,767.

I wrote the code so this shouldn't be a problem though. Also I had tried my code on some test data, 15 columns and 26000 rows, before posting it and also after your response and it worked fine both times.

So the error isn't immediately obvious to me and some debugging seems needed.

Could you run the following modified code and report any significant results.
That is, are the last used row and column identified correctly, and is the range you want to analyse selected correctly?

Sub delrowmod() ' as posted for Manojrf
Dim nr As Long
Dim nc As Long
Dim a As Variant
Dim i As Long
Dim j As Integer
Dim u() As Variant
Dim k As Long
Sheets("FILE").Activate
nr = Cells.Find("*", after:=Range("A1"), searchorder:=xlByRows, _
    searchdirection:=xlPrevious).Row
nc = Cells.Find("*", after:=Range("A1"), searchorder:=xlByColumns, _
    searchdirection:=xlPrevious).Column
MsgBox "last used row is " & nr & Chr(10) & _
    "last used column is " & nc
ReDim u(1 To nr, 1 To nc)
Set a = Cells(1).Resize(nr, nc)
a.Select
Exit Sub
Cells(1).Resize(nr, nc).ClearContents
For i = 1 To nr
    If InStr(a(i, 6), "CLOSED") = 0 Then
     k = k + 1
     For j = 1 To nc
        u(k, j) = a(i, j)
    Next j
    End If
Next i
Cells(1).Resize(k, nc) = u
End Sub

Which version of Excel are you using?

 

[manojrf]

Hi,

Thank you so much . This works fine. But it takes more time. In my case I have about 9000 rows to get deleted. It takes about 3-4 minutes. Is there anyway I can make the time shorter , in other word faster ?

Thank you. Manuel

Hi,

The macro code you sent works fine.Thank you so much.As told earlier it takes 3-4 minutes. Is there anyway to make it faster ? I have recorded another macro in this workbook. I use that macro now. I need to run the macro you sent me ,after the macro i have given below is run. I don't know how to join these two. Can you help me ?

I have given the code below.

Sub LOAD_Click()
'
' LOAD_Click Macro
'

'
Sheets("DATA").Select
Sheets("FILE").Select
Columns("A:BG").Select
Selection.ClearContents
With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\DEPOSIT.txt", _
Destination:=Range("A1"))
.Name = "DEPOSIT"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(9, 11, 22, 60, 8, 10, 11, 102, 8, 2, 3, 7, 253, 30, 36 _
, 14, 22, 40, 40, 40, 46, 14, 11, 12)
.Refresh BackgroundQuery:=False
End With

Rows("1:1").Select
Selection.Delete Shift:=xlUp
Columns("B:B").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Columns("D:D").Select
Selection.Cut
Range("B1").Select
ActiveSheet.Paste
Columns("E:E").Select
Selection.Cut
Range("C1").Select
ActiveSheet.Paste
Columns("G:G").Select
Selection.Cut
Range("D1").Select
ActiveSheet.Paste
Columns("I:I").Select
Selection.Cut
Range("E1").Select
ActiveSheet.Paste
Columns("K:K").Select
Selection.Cut
Range("F1").Select
ActiveSheet.Paste
Columns("N:N").Select
Selection.Cut
Range("G1").Select
ActiveSheet.Paste
Columns("P:P").Select
Selection.Cut
Range("H1").Select
ActiveSheet.Paste
Columns("R:R").Select
Selection.Cut
Range("I1").Select
ActiveSheet.Paste
Columns("S:S").Select
Selection.Cut
Range("J1").Select
ActiveSheet.Paste
Columns("T:T").Select
Selection.Cut
Range("K1").Select
ActiveSheet.Paste
Columns("V:V").Select
Selection.Cut
Range("L1").Select
ActiveSheet.Paste
Columns("W:W").Select
Selection.Cut
Range("M1").Select
ActiveSheet.Paste
Columns("X:X").Select
Selection.Cut
Range("N1").Select
ActiveSheet.Paste
Columns("O:Y").Select
Selection.ClearContents


Range("F1").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(RC[-5]="""",RC[-4]="""",RC[-3]=""""),""BLANK"",IF(AND(MID(RC[1],1,2)<>""SB"",MID(RC[1],1,2)<>""CA"",RC[-2]=0),""CLOSED"",""ACTIVE""))"
Range("F1").Select
Selection.AutoFill Destination:=Range("F1:F65536"), Type:=xlFillDefault
Columns("A:N").Select
Selection.Sort Key1:=Range("F1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom


End Sub

Regards, Manuel

 

[Tom Urtis]

For starters, see if this macro deletes the rows faster, which it should.

Sub Test1()
Application.ScreenUpdating = False
Dim LastRow&, FilterRange As Range
With Sheets("File")
.AutoFilterMode = False
LastRow = .Cells.Find("*", after:=.Range("A1"), searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Set FilterRange = .Range("F1:F" & LastRow)
FilterRange.AutoFilter Field:=1, Criteria1:="=CLOSED"
On Error Resume Next
FilterRange.SpecialCells(12).EntireRow.Delete
Err.Clear
.AutoFilterMode = False
End With
Set FilterRange = Nothing
Application.ScreenUpdating = True
End Sub

 

[mirabeau]

Hi,

The macro code you sent works fine.Thank you so much.As told earlier it takes 3-4 minutes. Is there anyway to make it faster ?

Manuel,

I'm not sure which code you refer to here as taking 3-4 minutes. The original code I posted doesn't take 3-4 minutes to handle a problem of the size you indicated.

In fact, when trying it on some test data it took less than a second on a relatively low spec computer to delete all rows with "CLOSED" in column 6.

Before looking at your requested additions in Post#7 above you should satisfy yourself on the speed of the code.

So, on a test datasheet (named "FILE") create the situation you outlined (26000 rows, about 15 cols, "CLOSED" in some of the cells of ColumnF) by just running the following test data code

Sub tstdataforclosed()
[a:m].ClearContents
Dim n As Long, i As Long, j As Integer, a()
n = 26000
ReDim a(1 To n, 1 To 15)
For i = 1 To n
For j = 1 To Int(Rnd * 8) + 8
    If Rnd < 0.7 Then
        a(i, j) = Chr(Int(Rnd * 26) + 65) & Chr(Int(Rnd * 26) + 97)
    Else
        a(i, j) = Chr(Int(Rnd * 9) + 48) & Chr(Int(Rnd * 9) + 48)
    End If
If (j = 6) * (Rnd < 0.4) Then a(i, 6) = "CLOSED"
Next j, i
[a1].Resize(n, 15) = a
End Sub

Then run the following code to delete rows with "CLOSED" in ColF. This is the same as my code in Post#6 above, but with the debugging testing removed. That code also tells you in a message box at the end how long it took.

Sub delrowmod() ' as posted for Manojrf
t = Timer
Dim nr As Long
Dim nc As Long
Dim a As Variant
Dim i As Long
Dim j As Integer
Dim u() As Variant
Dim k As Long
Sheets("FILE").Activate
nr = Cells.Find("*", after:=Range("A1"), searchorder:=xlByRows, _
    searchdirection:=xlPrevious).Row
nc = Cells.Find("*", after:=Range("A1"), searchorder:=xlByColumns, _
    searchdirection:=xlPrevious).Column
ReDim u(1 To nr, 1 To nc)
a = Cells(1).Resize(nr, nc)
Cells(1).Resize(nr, nc).ClearContents
For i = 1 To nr
    If InStr(a(i, 6), "CLOSED") = 0 Then
     k = k + 1
     For j = 1 To nc
        u(k, j) = a(i, j)
    Next j
    End If
Next i
Cells(1).Resize(k, nc) = u
MsgBox "Code took " & Format(Timer - t, "0.000")
End Sub

And, if interested, you can also use the test data code to compare the row-deletion speed of the code in Post#8 .