select specific rows (by different specified 7 digit ID numbers) from many rows in excel spreadsheet . delete all non-required rows.

The attached excel file includes a macro that deletes all rows apart from the selected postcode rows.
The original spreadsheet is the first worksheet.
The second worksheet shows the example of some of the rows required.

I am seeking an amended macro that will select the rows by the ID numbers in the attached .txt file.
EE-example--X-2-worksheets.xlsm
ID-list.txt
gregfthompsonAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
Try the attached. I didn't wind up with the same number of records as in your Required Example sheet but there's too many IDs in the input file to see which is correct. In the kTest code you'll need to change the path to the txt file and note that your formula construction needed to be changed because the txt file data ends in a comma.
28829899.xlsm
gregfthompsonAuthor Commented:
Thanks.

Hi Martin,

I amended the comma issue in the .txt file and changed the the script for the file location.

The script ran until this line:
Set r = .Cells(1).Offset(1).Resize(.Rows.Count - 1).SpecialCells(12)

It appears that it is not quite working.

Hope you can make sense of it.

Thanks,

Greg
Martin LissOlder than dirtCommented:
Please attach your workbook as it is now, and if you changed the txt file please also attach it.
Rowby Goren Makes an Impact on Screen and Online

Learn about longtime user Rowby Goren and his great contributions to the site. We explore his method for posing questions that are likely to yield a solution, and take a look at how his career transformed from a Hollywood writer to a website entrepreneur.

gregfthompsonAuthor Commented:
Workbook and amended IDlist.txt attached.
I've also attached the IDlist as rows in an .xlsx file.

I've also amended line in the script that keeps the top rows, from 10 to 4.

When I ran it the script deleted all rows and stopped at
Set r = .Cells(1).Offset(1).Resize(.Rows.Count - 1).SpecialCells(12)
28829899.xlsm
IDlist.txt
IDList.xlsx
Martin LissOlder than dirtCommented:
I'm using Excel 2010 and it runs fine for me.
28829899a.xlsm
aikimarkCommented:
When I apply an advancedfilter with your IDList.xls data as criteria and postcode=3185, I get a different number of rows (32) than you do in your Required worksheet (25).
gregfthompsonAuthor Commented:
Hi Martin,
Thanks for the file.

When I run the macro, nothing appears to occur.
Then I go to close the file and it appears as the attached.

It stops at
Set r = .Cells(1).Offset(1).Resize(.Rows.Count - 1).SpecialCells(12)

Thanks,

Greg
28829899b.xlsm
gregfthompsonAuthor Commented:
Hi aikimark,

When I apply an advancedfilter with your IDList.xls data as criteria and postcode=3185, I get a different number of rows (32) than you do in your Required worksheet (25).

My apologies - please ignore the postcode 3185.

The required ID numbers are across about 6 or 7 postcodes and are not in ascending order.

There are 316 ID numbers, and those are the 316 rows that I am seeking to keep.
All other rows (except the 4 header rows) can be deleted.

I hope that makes sense.

Thanks
Greg
Martin LissOlder than dirtCommented:
When I run the macro, nothing appears to occur.
Then I go to close the file and it appears as the attached.

It stops at
Set r = .Cells(1).Offset(1).Resize(.Rows.Count - 1).SpecialCells(12)
Is there anything to delete?
aikimarkCommented:
I've used two different lists of numbers and they don't filter the range below 6700+ (number of items).  Is this expected?
gregfthompsonAuthor Commented:
I think I may have not explained the problem correctly.

In the attached file called EE example.xlsx there are 6,972 rows, and each row has a different ID number in Column A.

I want to end up with a file that contains the 4 header rows, plus 304 rows, where the ID number in column A matches a number that is listed in IDlist.text or IDlist.xlsx.

IDlist.txt and IDlist.xlsx contain the same ID numbers in different formats, just in case you have a plan that could use either format.

The required ID numbers are not contiguous in the EE example.xlsx file.

Another way of explaining the objective is that I want to delete all rows, except the rows with the same ID number as the ID number contained in the IDlist.txt file or the IDlist.xlsx files.  

And, I also want to be able to use the same script (amended) to select different ID numbers in different files.

Does this make sense.

Thanks,

Greg
EE-example.xlsx
IDlist.txt
IDList.xlsx
aikimarkCommented:
Ah!  There is a space character before "ID" in the column header on your Original worksheet data.  That is why I couldn't get any filtering -- my criteria range header had no space.
aikimarkCommented:
Please try this combination.  I've added a Q_28829899() routine to module1.
Sub Q_28829899()
    Dim rng As Range
    Dim rngDel As Range
    Dim wks As Worksheet
    Dim wksCriteria As Worksheet
    
    Set wks = ThisWorkbook.Worksheets("Original")
    Set wksCriteria = Workbooks("IDList.xlsx").Worksheets("sheet1")
    
    'apply advancedfilter
    Application.ScreenUpdating = False
    Set rng = wks.Range(wks.Range("A4"), wks.Cells.SpecialCells(xlCellTypeLastCell))
    rng.AdvancedFilter xlFilterInPlace, _
            wksCriteria.Range(wksCriteria.Range("A1"), wksCriteria.Range("A1").End(xlDown))
    
    'delete the hidden rows
    For Each rng In wks.Range(wks.Range("A4"), wks.Range("A4").End(xlDown))
        If rng.EntireRow.Hidden Then
            If rngDel Is Nothing Then
                Set rngDel = rng.EntireRow
            End If
            Set rngDel = Union(rngDel, rng.EntireRow)
        End If
    Next
    Debug.Print "About to delete: " & rngDel.Address
    rngDel.Delete
    wks.ShowAllData
    Set rng = wks.UsedRange
    Debug.Print "Used Range after delete: " & rng.Address
    Application.ScreenUpdating = True
End Sub

Open in new window

Notes:
* The list of IDs needs a header= " ID"
* The code assumes the list of IDs workbook is open
IDList.xlsx
EE-example--X-2-worksheets.xlsm
gregfthompsonAuthor Commented:
Thanks Aikimark,

When I ran it, the Required Example showed only 10 rows.

I changed the code line:  "Const HeaderRow As Long = 10" to
"Const HeaderRow As Long = 308"

and the script stopped at
"Debug.Print "About to delete: " & rngDel.Address"
aikimarkCommented:
my code does not reference the HeaderRow value.
gregfthompsonAuthor Commented:
This is the code that is in the example I downloaded from your last comment.:
"Sub Q_28829899()
    Dim rng As Range
    Dim rngDel As Range
    Dim wks As Worksheet
    Dim wksCriteria As Worksheet
   
    Set wks = ThisWorkbook.Worksheets("Original")
    Set wksCriteria = Workbooks("IDList.xlsx").Worksheets("sheet1")
   
    'apply advancedfilter
    Application.ScreenUpdating = False
    Set rng = wks.Range(wks.Range("A4"), wks.Cells.SpecialCells(xlCellTypeLastCell))
    rng.AdvancedFilter xlFilterInPlace, _
            wksCriteria.Range(wksCriteria.Range("A1"), wksCriteria.Range("A1").End(xlDown))
   
    'delete the hidden rows
    For Each rng In wks.Range(wks.Range("A4"), wks.Range("A4").End(xlDown))
        If rng.EntireRow.Hidden Then
            If rngDel Is Nothing Then
                Set rngDel = rng.EntireRow
            End If
            Set rngDel = Union(rngDel, rng.EntireRow)
        End If
    Next
    Debug.Print "About to delete: " & rngDel.Address
    rngDel.Delete
    wks.ShowAllData
    Set rng = wks.UsedRange
    Debug.Print "Used Range after delete: " & rng.Address
    Application.ScreenUpdating = True
End Sub"
aikimarkCommented:
And no where in that code do I see Const HeaderRow As Long =
gregfthompsonAuthor Commented:
Sorry.

You're right. That's where the debug stopped,. 2nd last line.
""Debug.Print "About to delete: " & rngDel.Address""

The complete code is:
"Sub kTest()
   
    Dim i As Long, j As Long, r As Range, MyCodes
    Dim c As Long, Fmla  As String, p   As Long
   
 
    MyCodes = Split( _
                "2112901,2112902,2112903,2112904,2112905,2112906,2112907,2112908,2112909,2112910,2112911,2112912,2112913,2112914,2112915,2112916,2112921,2112922,2112923,2112924,2112925,2112926,2112927,2112928,2112929,2112930,2112931,2112932,2112933,2112934,2112935,2112936,2112937,2112938,2112939,2112940,2113314,2113315,2113328,2113330,2113331,2113332,2113335,2113336,2113405,2113406,2113407,2113408,2113409,2113410,2113413,2113414,2113415,2113416,2113417,2113418,2113419,2113420,2113421,2113423,2113424,2113425,2113426,2113427,2113428,2113430,2113431,2113432,2113433,2113434,2113435,2113436,2113437,2113438,2113439,2113506,2113513,2113518,2113519,2113628,2116901,2116902," & _
                "2116903,2116904,2116905,2116906,2116907,2116908,2116909,2116910,2116911,2116912,2116913,2116914,2116915,2116916,2116917,2116918,2116919,2116920,2116921,2116922,2116923,2116924,2116925,2116926,2116930,2116931,2116932,2116933,2116934,2116935,2116936,2116937,2116938,2116939,2116940,2116941,2116942,2116943,2116949,2116953,2117002,2117003,2117004,2117005,211700" & _
                "2117007,009,2117011,2117012,2117016,2117017,2117018,2117019,2117020,2117021,2117022,2117023,2117024,2117028,2117029,2117030,2117031,2117034,2117035,2117036,2117037,2117038,2117416,2117417,2117418,2117419,2117443,2117444,2117445,2117447,2117605,2117606,2117620,2117623,2117637,2117639,2117702,2117704,2117705,2117706,2117707,2117708,2117709,2117710,2117711,2117712,2117713,2117714,2117715,2117716,2117717,2117718,2117719,2117720,2117721,2117722,2117723,2117724,2117725,2117726,2117727,2117728,2117729,2117730,2117731,2117732,2117733,2117734,2117735,2117736,2117737,2117738,2117739,2117740,2117741,2117742,2117743,2117744,2117745,2117746,2117747,2117748,2117749," & _
                "2117750,2117751,2117752,2117753,2117754,2117801,2117802,2117803,2117804,2117805,2117806,2117807,2117808,2117809,2117810,2117811,2117812,2117813,2117814,2117815,2117816,2117817,2117818,2117819,2117820,2117821,2117822,2117823,2117824,2117825,2117826,2117827,2117828,2117829,2117830,2117831,2117832,2117833,2117834,2117835,2117836,2117837,2117838,2117839," & _
                "2117840,2117841,2117842,2117843,2117901,2117902,2117903,2117904,2117905,2117906,2117907,2117908,2117909,2117910,2117911,2117912,2117913,2117914,2117915,2117916,2117917,2117918,2117919,2117920,2117921,2117922,2117923,2117924,2117925,2117926,2117927,2117928,2118202,2118203,2118206,2118207,2118208,2118209,2118210,2118211,2118212,2118213,2118214,2118215,2118216,2118221,2118222,2118223,2118224")
   
    Const HeaderRow As Long = 10
   
    Application.ScreenUpdating = False

    On Error Resume Next
        ActiveWorkbook.CustomViews("$Temp$").Delete
    On Error GoTo 0
    ThisWorkbook.CustomViews.Add ViewName:="$Temp$", PrintSettings:=True, RowColSettings:=True
   
    For i = 1 To Worksheets.Count
        With Worksheets(i)
                       
            If .AutoFilterMode Then .AutoFilterMode = False
           
            p = .Range("a" & .Rows.Count).End(3).Row
            c = .Cells(HeaderRow, .Columns.Count).End(-4159).Column + 2
           
            With .Range("a" & HeaderRow & ":a" & p)
                Fmla = "=AND(A" & HeaderRow + 1 & "<>{"
                For j = LBound(MyCodes) To UBound(MyCodes)
                    Fmla = Fmla & MyCodes(j) & ","
                Next
                Fmla = Left(Fmla, Len(Fmla) - 1) & "})"
                .Cells(2, c).Formula = Fmla
                .AdvancedFilter 1, .Cells(1, c).Resize(2)
                Set r = .Cells(1).Offset(1).Resize(.Rows.Count - 1).SpecialCells(12)
                If Not r Is Nothing Then r.EntireRow.Delete
                Set r = Nothing
                .Cells(2, c).ClearContents
            End With
           
            .ShowAllData
                                   
        End With
    Next
   
    ThisWorkbook.CustomViews("$Temp$").Show
    ActiveWorkbook.CustomViews("$Temp$").Delete

End Sub




Sub Q_28829899()
    Dim rng As Range
    Dim rngDel As Range
    Dim wks As Worksheet
    Dim wksCriteria As Worksheet
   
    Set wks = ThisWorkbook.Worksheets("Original")
    Set wksCriteria = Workbooks("IDList.xlsx").Worksheets("sheet1")
   
    'apply advancedfilter
    Application.ScreenUpdating = False
    Set rng = wks.Range(wks.Range("A4"), wks.Cells.SpecialCells(xlCellTypeLastCell))
    rng.AdvancedFilter xlFilterInPlace, _
            wksCriteria.Range(wksCriteria.Range("A1"), wksCriteria.Range("A1").End(xlDown))
   
    'delete the hidden rows
    For Each rng In wks.Range(wks.Range("A4"), wks.Range("A4").End(xlDown))
        If rng.EntireRow.Hidden Then
            If rngDel Is Nothing Then
                Set rngDel = rng.EntireRow
            End If
            Set rngDel = Union(rngDel, rng.EntireRow)
        End If
    Next
    Debug.Print "About to delete: " & rngDel.Address
    rngDel.Delete
    wks.ShowAllData
    Set rng = wks.UsedRange
    Debug.Print "Used Range after delete: " & rng.Address
    Application.ScreenUpdating = True
End Sub"

And the "Const HeaderRow As Long =" is immediately under the list of ID numbers.
aikimarkCommented:
since you aren't calling my code, what does it matter?!?
gregfthompsonAuthor Commented:
Hi aikimark,

It is probably the way I am attempting to run the code.
I opened the file "EE-example--X-2-worksheets.xlsm"
and :IDList.xlsx"
I then ran the macro  "Q_28829899" which stopped.
Please see the attached screengrab.

Is the kTest code meant to be included?

Thanks,

Greg
screengrab-of-code-debug-page.JPG
aikimarkCommented:
1. It looks like you have already run the code once.  Did you restore the data in the Original worksheet or change the filtering values?

2. Going into break/debug mode is a annoying behavior that sometimes happens.  Just click the continue button.
gregfthompsonAuthor Commented:
I think that nothing appeared to occur when I clicked on run the macro the first time, and I clicked on it to run it again.

I started from the beginning again and downloaded your files again and ran the macro  Q_28829899 once.

The file appeared to be unchanged.
I've attached it.
EE-example--X-2-worksheets---code-r.xlsm
aikimarkCommented:
Was the workbook open, containing the list of ID values?
Was there a column header = " ID"?  (note that I have used quotes in order to let you know that there is a space character before "ID")
aikimarkCommented:
You got the same number of rows in the Original worksheet after running the macro that I did in my tests.  What did you expect?

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
gregfthompsonAuthor Commented:
IDList.xlsx was open.
I think IDList.xlsx is correct.

It is attached.
IDList.xlsx
gregfthompsonAuthor Commented:
Hi Aikimark,

It is all working.

My fault.  I thought the result was meant to appear in the Required Example worksheet.

Thanks for your patience.

Sincere apologies,

Greg
gregfthompsonAuthor Commented:
Thanks heaps!!!
gregfthompsonAuthor Commented:
Hi Aikimark,

It appears I was too eager.

The macro did not provide the 304 rows as required.
In the original worksheet there are still 2,892 rows.

What I am seeking to do is to end up with a worksheet that contains 304 rows that contain the ID number.

Thanks,

Greg
gregfthompsonAuthor Commented:
That is a version of the "Original" worksheet that contains only those rows that contain the same ID number as in the "IDList" worksheet.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.