Automated multiple row removal by criteria

[Jak]

I have a spreadsheet with a title row ("A1 to G1"). Below the title row is a range of data which currently resides in ("A2 to G41444"). Column 6 is titled "Centre Number" and is made up of a column of numbers, some with numbers and letters (see sample data below). What I need to do is test this column and delete any row within the spreadsheet that does not have one of the numbers below in column 6. There are 59 different numbers to be tested. I am hoping to have this automated as the number of rows will vary. Any ideas would be welcomed. If this is not clear or you need additional info, let me know. Thanks.


001045
002145
039283
001053
048302
048944
048945
048946
014119
002248
059010
020111
010089
020089
002305
037430
055322
001903
002272
044950
000933
048217
010119
002411
042255
002377
041244 G6
041244
052324
726492
072132
049932
002235
001090
002126
001057
005133
020104H
020104
020104D
020239
025288
058653
020250
030405
002116
058621
039106
044325
032135
021902
001088
000837
019311
050645
035219
000602
001026
001963

 

[Tazguy37]

Kinda the long way of going about it, but it works:

Sub cleanList()

Dim arElem
Dim iRow As Long
Dim myArray
Dim Found As Boolean

    Found = False
    myArray = Array("1045", "2145", "39283", "1053", "48302", "48944", "48945", "48946", "14119", "2248", "59010", _
            "20111", "10089", "20089", "2305", "37430", "55322", "1903", "2272", "44950", "933", "48217", "10119", "2411", "42255", _
            "2377", "41244  G6", "41244", "52324", "726492", "72132", "49932", "2235", "1090", "2126", "1057", "5133", "20104 H", _
            "20104", "020104D", "20239", "25288", "58653", "20250", "30405", "2116", "58621", "39106", "44325", "32135", "21902", _
            "1088", "837", "19311", "50645", "35219", "602", "1026", "1963")

    For iRow = Range("F" & Rows.Count).End(xlUp).Row To 2 Step -1
        For Each arElem In myArray
            If arElem = CStr(Cells(iRow, 6).Value) Then
                Found = True
                Exit For
            End If
        Next arElem
        If Not Found Then Cells(iRow, 1).Resize(, 7).Delete xlUp
        Found = False
    Next iRow

End Sub

• How to use the above code:
  
  Press Alt-F11 to open the VBE.
  Press Control-R to open the Project Explorer.
  Click "Microsoft Excel Objects" for the file you're working on.
  Select Insert, Module from the drop down menus.
  
  Open the Code pane with F7.
  Paste the above code in.
  Press Alt-Q to close the VBE and return to Excel

Hope that helps!

 

[Jak]

Thanks Tazguy37

Takes a while to run on this much data but quicker than doing it the manual way. Added Screenupdating = False to the code as its a bit bad on the eyes otherwise, lol. Many thanks for the help.

 

[Tazguy37]

Added Screenupdating = False to the code as its a bit bad on the eyes otherwise, lol. Many thanks for the help.

Yeah, I took that out, so I wouldn't have to keep resetting it after trial runs. You're welcome!

Cool sig, BTW!