VBA copy multiple delimited ranges from one column to new worksheet with a string

[setai25]

Hello,

I have an enormous data set in a single column (180k line config file dump), and need to copy any ranges where the first cell contains a string. The ranges are delimited by a specific series of cells, and the first cell in a range starts with the same text string. The string I need to search by is a 7-digit id number.

I found a script that copies cells containing a string to a new worksheet: Search for substring and copy results to new worksheet?
This is half of what I am looking to accomplish.
I would like to copy the entire ranges of cells where the first cell in the range contains the specified string.

Sample Data

ssssssssss

ssssssssss

ACO: site.com: 1234567 - name1

DataPoint1

DataPoint2

DataPoint3

DataPoint4

ssssssssss

ssssssssss

ACO: site2.com: 7539516 - name2

DataPoint2

DataPoint4

DataPoint4

ssssssssss

ssssssssss

<tbody>
</tbody>

This is the code DMcClenagan posted:

Sub FindStringManyTimes()
    Dim ii As Integer
    Dim gFind, gPlug As Long
    Dim bRet As Boolean
    Dim oo As Object
    
    Sheets.Add
    ActiveSheet.Name = "ListOfFinds"
    For ii = 2 To Sheets.Count
        With Sheets(ii)
            bRet = bAnyCells(Sheets(ii).Name)
            If bRet Then
                For Each oo In .Cells.SpecialCells(xlCellTypeConstants)
                    gFind = InStr(1, oo.Value, "ACO: ")
                    If gFind > 0 Then
                        gPlug = gPlug + 1
                        Cells(gPlug, 1).Value = oo.Value
                        Cells(gPlug, 2).Value = Sheets(ii).Name
                        Cells(gPlug, 3).Value = oo.Address(False, False)
                    End If
                Next oo
            End If
        End With
    Next ii
End Sub
Function bAnyCells(sSheet As String) As Boolean
    Dim oo As Object
    On Error GoTo Bye
    With Sheets(sSheet)
        For Each oo In .Cells.SpecialCells(xlCellTypeConstants)
        Next oo
    End With
    bAnyCells = True
Bye:
    On Error GoTo 0
End Function

Many thanks, in advance.

 

[StephenCrump]

I am guessing that for the example below, you'll want to copy all the lines highlighted if you are searching for 1234567?

The code you've posted is based on looping, and will take a long time with 180,000 rows of data. Better to filter and copy in bulk. Here's one way you could do this, using a helper column:

B2: =IF(LEFT(A2,4)="ACO:",TRIM(MID(SUBSTITUTE(TRIM(A2)," ",REPT(" ",50)),100,50)),IF(ISBLANK(A2),0,B1))

This assumes your data is well behaved, and ID is located between 2nd and 3rd space(?)

Now simply filter and copy/paste the filtered results.

If you need to repeat for multiple IDs, it will be relatively simple to write a macro to loop through.

Excel Workbook
	A	B
1	Sample Data
2	ssssssssss	0
3	ssssssssss	0
4	ACO: site.com: 1234567 - name1	1234567
5	DataPoint1	1234567
6	DataPoint2	1234567
7	DataPoint3	1234567
8	DataPoint4	1234567
9	ssssssssss	1234567
10	ssssssssss	1234567
11		0
12	ACO: site2.com: 7539516 - name2	7539516
13	DataPoint2	7539516
14	DataPoint3	7539516
15	DataPoint4	7539516
16		0
17	ACO: site.com: 1234567 - name3	1234567
18	DataPoint1	1234567
19	DataPoint2	1234567
Sheet1

 

[setai25]

That is pretty good...the data isn't as well behaved as I'd like. However, cleaning isn't a tough job with this solution (it shows where human data entry missed).

As "they" say, perfect is the enemy of complete. I think this will get me there.

Thanks, very much.