VBA: Extract variable number of rows per variable number of phone numbers

[hirick12]

VBA: Extract variable number of rows per variable number of phone numbers

We are looking to automate this process using Excel VBA/macros because we process two to ten spreadsheets a week. We want to extract a certain number of rows per a variable set of phone numbers. For example: a spreadsheet with 200,000 rows has 20,000 rows assigned to ten phone numbers. We want to extract the first ten rows per phone number. Our resulting file will have 100 rows ordered by phone number.


Notes: We need to extract a variable number of records per phone number.
The number of columns can vary. The number of rows can vary.
We need the entire row of data.
The phone number column may be in a different place in each spreadsheet.
The number of phone numbers may vary.


Here's a code that works on one file, but cannot be duplicated to another worksheet because the "field", "criteria" and "rows" change per worksheet.


We thought IndexMatch might work, but it only returns one item, rather than duplicates.


We don't have a VBA solution, so we do this manually.


Any help would be appreciated!


Sub ExtractPh()

' Establish filter ' Choose first unique phone number

<code>Cells.Select
Selection.AutoFilter
ActiveSheet.UsedRange.AutoFilter Field:=25, Criteria1:= _
"800-836-9207"</code>

' Copy ten non-sequential rows from row 1 to row 82

Rows("1:82").Select
<code>Selection.Copy</code> ' Add rows to second sheet
<code>Sheets.Add After:=Sheets(Sheets.Count)
Rows("1:1").Select
ActiveSheet.Paste</code>

' Move second to sheet to first position to save as separate file

<code>Sheets("Sheet1").Select
Application.CutCopyMode = False
Sheets("Sheet1").Move Before:=Sheets(1)</code>

' Return to main data sheet

<code>Sheets("Test LKY job").Select</code> ' Choose second unique phone number in column
<code>ActiveSheet.UsedRange.AutoFilter Field:=25, Criteria1:= _
"800-907-3803"</code>

' Choose second set of ten non-sequential rows and paste to first sheet

<code>Rows("6:26").Select
Selection.Copy
Sheets("Sheet1").Select
Rows("12:12").Select
ActiveSheet.Paste</code>

' Return to main data sheet

<code>Sheets("Test LKY job").Select</code> ' Choose third unique phone number in column
<code>ActiveSheet.UsedRange.AutoFilter Field:=25, Criteria1:= _
"800-538-1668"</code>

' Choose third set of non-sequential rows and paste to first sheet

<code>Rows("4:48").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Rows("22:22").Select
ActiveSheet.Paste</code> End Sub
(EOF)