Delete rows that contains certain text - fastest way

[saulodefaria]

Hi guys!

Here's my problem: I have some huge txt files (~700k lines) with csv data from stock prices. One of the columns is the name of the company. So I want to get only the lines of certain companies. I actually already have a solution, but it is taking too much time. I think it may take hours to filter just one txt file, but I have lots of them...

Here's the code I'm using now:

Sub delete()


Dim dontDelete
dontDelete = Array("APPLE", "MICROSOFT", "GOOGLE")


Dim i As Long, j As Long


Dim isThere As Boolean


For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    For j = LBound(dontDelete) To UBound(dontDelete)
        If InStr(1, Range("A" & i), dontDelete(j)) Then
            isThere = True
        End If
    Next j
    If Not isThere Then
        Range("A" & i).delete shift:=xlUp
    End If
    isThere = False
Next i


End Sub

It does the job. But I was hoping I could get some ideas to do it faster.

Thanks!

 

[AlphaFrog]

Try this...

[color=darkblue]Sub[/color] delete()
    
    [color=darkblue]Dim[/color] LastCol [color=darkblue]As[/color] [color=darkblue]Long[/color], i [color=darkblue]As[/color] Long
    [color=darkblue]Dim[/color] dontDelete [color=darkblue]As[/color] [color=darkblue]Variant[/color], v [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    
    dontDelete = Array("APPLE", "MICROSOFT", "GOOGLE")
    v = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
    LastCol = Cells.Find("*", , , , 2, 2).Column + 1
    
    [color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] [color=darkblue]UBound[/color](v, 1)
        [color=darkblue]If[/color] IsNumeric(Application.Match(v(i, 1), dontDelete, 0)) [color=darkblue]Then[/color]
            v(i, 1) = i
        [color=darkblue]Else[/color]
            v(i, 1) = ""
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] i
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    [color=darkblue]With[/color] Cells(1, LastCol).Resize(UBound(v, 1))
        .Value = v
        .EntireRow.Sort Cells(1, LastCol), xlDescending, Header:=xlNo
        .SpecialCells(xlCellTypeBlanks).EntireRow.ClearContents
        .ClearContents
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[renigar]

This assumes all of the cells with the company name you are looking for are in column A. You're basically doing a find for the company name and replacing it with a blank cell. Then Goto Special, Select Blanks, and delete all of the sheet rows in column A that contain blank cells. Then you can tweak it for ease of use. Depending on the version of excel you have and the amount of memory on your machine this may or may not work. I've had sheets with 60,000 rows on an XP machine with 3 GB ram and Excel 2007 choke on this but a windows 7 machine with 8 GB work just fine. Have no idea what 700,000 rows will do though.

Columns("A:A").Select
    Selection.Replace What:="CompanyName", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete

Sorry, I reread your post and this is not what your looking for.

 

[hiker95]

saulodefaria,

Welcome to the MrExcel forum.

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?

If I understand you correctly.

I assume that your text file data only uses column A.

Sample raw data in column A (not all 756,000 rows are shown):

Excel 2007
	A
1	Apple1
2	Microsoft2
3	Google3
4	other4
5	another5
6	one more6
7	Apple7
8	Microsoft8
9	Google9
10	other10
11	another11
12	one more12
13	Apple13
14	Microsoft14
15	Google15
16	other16
17	another17
18	one more18
19	Apple19
20	Microsoft20
21	Google21
22	other22
23	another23
24	one more24
25	Apple25
26	Microsoft26
27	Google27
Sheet1

After the macro using two arrays in memory (with a macro run time of 9.594 seconds):

Excel 2007
	A
1	Apple1
2	Microsoft2
3	Google3
4	Apple7
5	Microsoft8
6	Google9
7	Apple13
8	Microsoft14
9	Google15
10	Apple19
11	Microsoft20
12	Google21
13	Apple25
14	Microsoft26
15	Google27
16	Apple31
17	Microsoft32
18	Google33
19	Apple37
20	Microsoft38
21	Google39
22	Apple43
23	Microsoft44
24	Google45
25	Apple49
26	Microsoft50
27	Google51
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Option Compare Text
Sub KeepAppleMicrosoftGoogle()
' hiker95, 07/09/2014, ME790233
Dim oa As Variant, a As Variant
Dim i As Long, j As Long, lr As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set oa = Range("A1:A" & lr)
ReDim a(1 To lr, 1 To 1)
For i = 1 To lr
  If InStr(oa(i, 1), "apple") Or InStr(oa(i, 1), "microsoft") Or InStr(oa(i, 1), "google") Then
    j = j + 1
    a(j, 1) = oa(i, 1)
  End If
Next i
Range("A1:A" & lr) = a
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the KeepAppleMicrosoftGoogle macro.

 

[saulodefaria]

I was almost giving up thinking "700k lines, it's imposible to do that fast..." but then this! haha thanks guys!

AlphaFrog, your code ran very fast but I don't know why it deleted all rows :/

hiker95, your code ran perfectly. It does the job in less than 10 seconds!

Thanks a lot!

 

[hiker95]

saulodefaria,

Sample raw data with more than one column:

Excel 2007
	A	B
1	Apple1	1
2	Microsoft2	2
3	Google3	3
4	other4	4
5	another5	5
6	one more6	6
7	Apple7	7
8	Microsoft8	8
9	Google9	9
10	other10	10
11	another11	11
12	one more12	12
13	Apple13	13
14	Microsoft14	14
15	Google15	15
16	other16	16
17	another17	17
18	one more18	18
19	Apple19	19
20	Microsoft20	20
21	Google21	21
22	other22	22
23	another23	23
24	one more24	24
25	Apple25	25
26	Microsoft26	26
27	Google27	27
Sheet1

After the macro:

Excel 2007
	A	B
1	Apple1	1
2	Microsoft2	2
3	Google3	3
4	Apple7	7
5	Microsoft8	8
6	Google9	9
7	Apple13	13
8	Microsoft14	14
9	Google15	15
10	Apple19	19
11	Microsoft20	20
12	Google21	21
13	Apple25	25
14	Microsoft26	26
15	Google27	27
16	Apple31	31
17	Microsoft32	32
18	Google33	33
19	Apple37	37
20	Microsoft38	38
21	Google39	39
22	Apple43	43
23	Microsoft44	44
24	Google45	45
25	Apple49	49
26	Microsoft50	50
27	Google51	51
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Option Compare Text
Sub KeepAppleMicrosoftGoogleV2()
' hiker95, 07/09/2014, ME790233
Dim oa As Variant, a As Variant
Dim i As Long, j As Long, lr As Long, lc As Long, c As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column
Set oa = Range(Cells(1, 1), Cells(lr, lc))
ReDim a(1 To lr, 1 To lc)
For i = 1 To lr
  If InStr(oa(i, 1), "apple") Or InStr(oa(i, 1), "microsoft") Or InStr(oa(i, 1), "google") Then
    j = j + 1
    For c = 1 To lc
      a(j, c) = oa(i, c)
    Next c
  End If
Next i
Range(Cells(1, 1), Cells(lr, lc)) = a
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the KeepAppleMicrosoftGoogleV2 macro.

 

[saulodefaria]

hiker95,

Just one more thing: actually there are like 20 companies that I want to keep (not only 3), so is there a smarter way to put all the company names as constraint (maybe in an array) instead of doing ---InStr(oa(i, 1), "companyX") Or--- to all companies?

Thanks in advance!

 

[AlphaFrog]

I was almost giving up thinking "700k lines, it's imposible to do that fast..." but then this! haha thanks guys!

AlphaFrog, your code ran very fast but I don't know why it deleted all rows :/

hiker95, your code ran perfectly. It does the job in less than 10 seconds!

Thanks a lot!

I was looking for whole matches for what it's worth.
Hiker95 does good code and it appears to work for you.

 

[hiker95]

AlphaFrog,

Hiker95 does good code and it appears to work for you.

I appreciate that. Thank you very much.

 

[hiker95]

saulodefaria,

hiker95, your code ran perfectly. It does the job in less than 10 seconds!

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.