Delete all rows that don't start with CRN or AT

[Djblois]

I want to be able to delete all rows that don't begin with AT or CRN in column A. Ex:

AT12345
AT56789
CRN12345
CRN56789
(Cust
GHI

I want it to delete the whole row that has (Cust and GHI at the beginning of the A column. This is just an example there may be much more I need it to delete that is why I want it to delete it if it doesn't begin with AT or CRN. That is a must.

I would also like it then to delete anything that starts with ATalanta. but it must have Atalanta in it not just AT.

[mdmackillop]

How many rows are you dealing with?

[Djblois]

Always different

[mdmackillop]

10, 100, 60000?

[Djblois]

Can go from 15 all the way up to 60000. This is for the macro I am doing it depends on how much info the user wants from our system.

[mdmackillop]

Thanks,
It changes the methodology as I guess looping 60000 cells will take a while

[Djblois]

Don't thank me, I should be thanking you. You are the one helping me. Thank you for all the help!!!!!!

[mdmackillop]

Try this.
It writes a value "x" into column 7 and then filters on that column. You may need to change this to suit your data

 
Option Explicit

Sub KeepSelectedRows()
    Dim StartToKeep, STK
    StartToKeep = Array("AT", "CRN")
    Rows(1).Insert
    Cells(1, 1) = "Sacrifice"
    'Mark rows to keep
    For Each STK In StartToKeep
        Cells.AutoFilter Field:=1, Criteria1:=STK & "*"
        Intersect(ActiveSheet.UsedRange, _
        Columns(1).SpecialCells(xlCellTypeVisible)).Offset(, 6) = "x"
        Cells.AutoFilter
    Next
    'Delete unmarked rows
    Rows(1).Insert
    Cells(1, 1) = "Sacrifice"
    Cells.AutoFilter Field:=7, Criteria1:="="
    Intersect(ActiveSheet.UsedRange, _
    Columns(1).SpecialCells(xlCellTypeVisible)).EntireRow.Delete
    'Delete ATalanta rows
    Cells.AutoFilter Field:=1, Criteria1:="ATalanta*"
    Intersect(ActiveSheet.UsedRange, _
    Columns(1).SpecialCells(xlCellTypeVisible)).EntireRow.Delete
    Columns(7).ClearContents
End Sub

[Djblois]

Mdmack,

Can you explain to me exactly what that does? It will delete anything that doesn't begin with At or CRN??? I don't want to have to select the row at first. Also, there may be blank rows in there also that I want it to delete also (sorry, I forgot to tell you that before)

[mdmackillop]

The code uses autofilter to find any rows starting with the strings listed in StartToKeep array and insets an X in a corresponding column. It does this for each term. It then searches that column for blanks and deletes all rows found. Finally, it searches for Atalanta, and deletes all rows found. I've amended my code in the attached example to keep blanks in Column A

 
Option Explicit

Sub KeepSelectedRows()
    Dim StartToKeep, STK
    Application.ScreenUpdating = False
    StartToKeep = Array("AT*", "CRN*", "=")
    Rows(1).Insert
    Cells(1, 1) = "Sacrifice"
    'Mark rows to keep
    For Each STK In StartToKeep
        Cells.AutoFilter Field:=1, Criteria1:=STK
        Intersect(ActiveSheet.UsedRange, _
       Columns(1).SpecialCells(xlCellTypeVisible)).Offset(, 6) = "x"
       Cells.AutoFilter
    Next
    'Delete unmarked rows
    Rows(1).Insert
    Cells(1, 1) = "Sacrifice"
    Cells.AutoFilter Field:=7, Criteria1:="="
    Intersect(ActiveSheet.UsedRange, _
    Columns(1).SpecialCells(xlCellTypeVisible)).EntireRow.Delete
    'Delete ATalanta rows
    Cells.AutoFilter Field:=1, Criteria1:="ATalanta*"
    Intersect(ActiveSheet.UsedRange, _
    Columns(1).SpecialCells(xlCellTypeVisible)).EntireRow.Delete
    'Clear filter column
    Columns(7).ClearContents
    Application.ScreenUpdating = True
End Sub

[Djblois]

wow you are the man. That works perfect

[rrtts]

@MD - this is spot on and works GREAT!

One question though...how hard would it be (or is it even possible) to code into the formula something like the "Text to Columns" function...

My current process is I paste about 125 rows of text in column A, select Text to Columns and go through that whole process of setting up delimiters and then click the button with the macro you've created. It deletes the desired fields perfectly...but then the next time (3 times a day) I have to do this I have to set up "Text to Columns" again.

Anways...after much searching...I'm so glad to have found this tip...dozens of a tips on how to delete empty rows or specificed text from rows...this is the only one I found that allows you to set specific text to keep...

nice!

[mdmackillop]

Can you post a sample containing your text and a note of the text to keep?

[rrtts]

I have the macro set up to delete the exact text I need to, my problem is then automating the next step. I assume you mean a sample of the text I have left that I want to separate into columns by setting delimiters.
Basically it is 125 rows of data in the following format.

RHHIxxx/Unit Name
RHHMxxx/Unit Name
x=various values

Unit Name is always two parts - i.e. HMAS Waller

So, in a perfect world...



I could cut and paste this into my worksheet...click my macro button that deletes the header and footer off of this text and have 3 columns of text.

RHHIABC/HMAS WALLER = RHHIABC HMAS WALLER (each in a column)

Hope that helps - and thanks for the help.

[mdmackillop]

Use the Split function

 
Sub SplitText()
    Dim cel As Range
    For Each cel In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
        arr = Split(cel, "/")
        cel = arr(0)
        cel.Offset(, 1) = Split(arr(1), " ")(0)
        cel.Offset(, 2) = Split(arr(1), " ")(1)
    Next
End Sub

[rrtts]

I think I am doing something wrong...I keep getting a runtime error that says subscript out of range.

I've tinkered around with it, but obviously I'm not smart enough to figure it out. I cut and pasted your formula straight from the site, so I know I didn't type it in wrong.

Any ideas?

Thanks for the continued help!

[mdmackillop]

Can you post some of your text in a workbook?

[rrtts]

XXXXXXXX XXXXXXX0001 0010001-XXXX--XXXXXXX.
XXX XXXXX
X 010001Z XXX 06
FM ORIGINATOR
TO RHHIABC/UNIT 1
RHHIDEF/UNIT 2
RHHIABC/UNIT 3
RHHIABC/UNIT 4
RHHIABC/UNIT 5
RHHIDEF/UNIT 6
RHHIABC/UNIT 7
RHHIABC/UNIT 8
RHHIDEF/UNIT 9
RHHIABC/UNIT 10
RHHIABC/UNIT 11
RHHIDEF/UNIT 12
RHHIABC/UNIT 13
RHHIGHI/UNIT 14
RHHIABC/UNIT 15
RHHIABC/UNIT 16
RHHIGHI/UNIT 17
RHHIABC/UNIT 18
RHHIABC/UNIT 19
RHHIGHI/UNIT 20
RHHIABC/UNIT 21
RHHIABC/UNIT 22
RHHIGJO/UNIT 23
RHHIABC/UNIT 24
RHHIABC/UNIT 25
RHHIDEF/UNIT 26
RHHIABC/UNIT 27
SUBJ/TEST//
REMARKS/THIS IS A TEST MESSAGE. NO ACTION REQUIRED.//
END OF MESSAGE
NNNN

*Using your delete macro, I can delete the header/footer info and just have the "Unit" info in the routing indicator(RHHI***)/unit name format.

Now, I'm trying to use something similar to the "text to columns" function to separate the routing indicator (RHHI***) and unit name into two different columns.

That will lead to the final step of sorting each unit into a specific category based on routing indicator, but only the Unit name will appear...(all of it is just regular .txt data - I have the formula to do this thanks to xld)

Hope this helps (I don't have the worksheet on this machine or I would post it)

[mdmackillop]

My previous code would fail if there was no / in the text. Try this version which skips any such values

 
Sub SplitText()
    Dim cel As Range
    For Each cel In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
        arr = Split(cel, "/")
        If InStr(1, cel, "/") = 0 Then GoTo Skipped
        cel = arr(0)
        cel.Offset(, 1) = Split(arr(1), " ")(0)
        cel.Offset(, 2) = Split(arr(1), " ")(1)
        Skipped:
    Next
End Sub

[rrtts]

I'm at a loss of words...you are too kind...my only other question (for now) is how did you get so smart at this...heh heh.

Everything works perfectly and you have made my job so much easier...I'm learning lots but also realize I have a LONG way to go.

Have a great day!