Searching for a string and move it's data to different sheets

[xboon_95]

Hi all,

I'm trying to import a .txt file to Excel and the program will filter a string called "¯ Starting Leak Checking(negative pressure)..." in column A only, and once it is found, the program will move this string onwards to the next sheet. For instance, the data is shown below :

¯ Starting Leak Checking(negative pressure)...

00:00:00 00:00:01 L -86 1 115
00:00:00 00:00:02 L -80 2 123
00:00:00 00:00:03 L -90 2 122
00:00:00 00:00:04 O -98 2 156
00:00:00 00:00:05 P -104 2 135
00:00:00 00:00:06 L 5 1 453
00:00:00 00:00:07 L 10 2 123

¯ Starting Leak Checking(negative pressure)...

00:00:01 00:00:01 L -87 1 117
00:00:02 00:00:02 P -86 1 154
00:00:03 00:00:03 O -91 2 167
00:00:04 00:00:04 O -98 2 156
00:00:05 00:00:05 P -104 2 135
00:00:06 00:00:06 L 7 1 453
00:00:07 00:00:07 L 10 2 127

¯ Starting Leak Checking(negative pressure)...
00:00:08 00:00:01 L -87 1 117
00:00:09 00:00:02 P -86 1 154
00:00:10 00:00:03 O -91 2 167
00:00:11 00:00:04 O -98 2 156
00:00:12 00:00:05 P -104 2 135
00:00:13 00:00:06 L 7 1 453
00:00:14 00:00:07 L 10 2 127

¯ Starting Leak Checking(negative pressure)...
00:00:15 00:00:01 L -87 1 117
00:00:16 00:00:02 P -86 1 154
00:00:17 00:00:03 O -91 2 167
00:00:18 00:00:04 O -98 2 156
00:00:19 00:00:05 P -104 2 135
00:00:20 00:00:06 L 7 1 453
00:00:21 00:00:07 L 10 2 127

Since there are 4 strings of "¯ Starting Leak Checking(negative pressure)...", what I'm trying to achieve now is to move these data into 4 different sheets, with the first string of "¯ Starting Leak Checking(negative pressure)..." and it's data in the first sheet, second string of "¯ Starting Leak Checking(negative pressure)..." in the second sheet and ultimately, there will be 4 different sheets. Is it possible to do this? Any help will be appreciated. I tried the code below but it doesn't work.

Dim c As Range, i As Long
Dim firstAddress As String
i = 1
With Range("A1:Q18215")
Set c = .Find("Dim c As Range, i As Long Dim firstAddress As String
i = 1
With Range("A1:Q18215")
Set c = .Find("» Starting Leak Checking(negative pressure)...")
If Not c Is Nothing Then
firstAddress = c.Address
Do
.Range(c, c.End(xlDown)).Copy Sheets("sheet" & i).Range("A1:Q18215")
i = i + 1
Set c = .FindNext(c)
Loop Until c.Address = firstAddress
End If
End With")
If Not c Is Nothing Then
firstAddress = c.Address
Do
.Range(c, c.End(xlDown)).Copy Sheets("sheet" & i).Range("A1:Q18215")
i = i + 1
Set c = .FindNext(c)
Loop Until c.Address = firstAddress
End If
End With

[mikerickson]

I think that this will do what you want.
Note that it adds a fourth dot to every key cell. This prevents it being run multiple times on the same data.

Sub test()
    Dim keyPhrase As String
    Dim topCell As Range, bottomCell As Range
    Dim dataCells As Variant
    Dim sourceSheet As Worksheet
    
    Set sourceSheet = Sheet1
    keyPhrase = "¯ Starting Leak Checking(negative pressure)..."
    Application.ScreenUpdating = False
    
    With sourceSheet.Columns(1)
        Set bottomCell = .Cells(.Rows.Count, 1).End(xlUp)
        Set topCell = .Find(keyPhrase, After:=bottomCell, SearchDirection:=xlPrevious, LookAt:=xlWhole)
        
        Do Until (topCell Is Nothing)
            If (bottomCell.Row < topCell.Row) Then Exit Do
            
            With .Parent.Parent
                With .Worksheets.Add(after:=.Sheets(.Sheets.Count), Type:=xlWorksheet)
                    Range(topCell, bottomCell).EntireRow.Copy Destination:=.Range("A1")
                End With
            End With
            
            topCell.Value = keyPhrase & "."
            
            Set bottomCell = topCell.End(xlUp)
            Set topCell = .Find(keyPhrase, After:=bottomCell, SearchDirection:=xlPrevious, LookAt:=xlWhole)
        Loop
    End With
    
    Application.ScreenUpdating = True
End Sub

[xboon_95]

I think that this will do what you want.
Note that it adds a fourth dot to every key cell. This prevents it being run multiple times on the same data.

Sub test()
    Dim keyPhrase As String
    Dim topCell As Range, bottomCell As Range
    Dim dataCells As Variant
    Dim sourceSheet As Worksheet
    
    Set sourceSheet = Sheet1
    keyPhrase = "¯ Starting Leak Checking(negative pressure)..."
    Application.ScreenUpdating = False
    
    With sourceSheet.Columns(1)
        Set bottomCell = .Cells(.Rows.Count, 1).End(xlUp)
        Set topCell = .Find(keyPhrase, After:=bottomCell, SearchDirection:=xlPrevious, LookAt:=xlWhole)
        
        Do Until (topCell Is Nothing)
            If (bottomCell.Row < topCell.Row) Then Exit Do
            
            With .Parent.Parent
                With .Worksheets.Add(after:=.Sheets(.Sheets.Count), Type:=xlWorksheet)
                    Range(topCell, bottomCell).EntireRow.Copy Destination:=.Range("A1")
                End With
            End With
            
            topCell.Value = keyPhrase & "."
            
            Set bottomCell = topCell.End(xlUp)
            Set topCell = .Find(keyPhrase, After:=bottomCell, SearchDirection:=xlPrevious, LookAt:=xlWhole)
        Loop
    End With
    
    Application.ScreenUpdating = True
End Sub

OMG it works like a charm !!! Now I'm facing another problem, which is the naming of the sheets. For all my calculation codes, I only indicated "Sheet1" as my desired sheet. In this case, since the data is separated into different sheets, the naming of the sheets will be different. How do I solve this problem? Since I can't standardize the name of the sheets. Hope that you can help me with this.

[mikerickson]

You can standardize the sheet names (MySheet1, MySheet2, MySheet3, etc.).

Put this UDF into the same module as test

Function NextSheetName() As String
    Const Prefix As String = "MySheet"
    Dim oneSheet As Worksheet
    Dim MaxName As Long
    For Each oneSheet In ThisWorkbook.Worksheets
        With oneSheet
            If .Name Like Prefix & "*" Then
                MaxName = WorksheetFunction.Max(0, Replace(.Name, Prefix, vbNullString))
            End If
        End With
    Next oneSheet
    NextSheetName = Prefix & (MaxName + 1)
End Function

And add one line to test

            With .Parent.Parent 
                With .Worksheets.Add(after:=.Sheets(.Sheets.Count), Type:=xlWorksheet) 
                    Range(topCell, bottomCell).EntireRow.Copy Destination:=.Range("A1")
                    .Name = NextSheetName
                End With 
            End With

[xboon_95]

You can standardize the sheet names (MySheet1, MySheet2, MySheet3, etc.).

Put this UDF into the same module as test

Function NextSheetName() As String
    Const Prefix As String = "MySheet"
    Dim oneSheet As Worksheet
    Dim MaxName As Long
    For Each oneSheet In ThisWorkbook.Worksheets
        With oneSheet
            If .Name Like Prefix & "*" Then
                MaxName = WorksheetFunction.Max(0, Replace(.Name, Prefix, vbNullString))
            End If
        End With
    Next oneSheet
    NextSheetName = Prefix & (MaxName + 1)
End Function

And add one line to test

            With .Parent.Parent 
                With .Worksheets.Add(after:=.Sheets(.Sheets.Count), Type:=xlWorksheet) 
                    Range(topCell, bottomCell).EntireRow.Copy Destination:=.Range("A1")
                    .Name = NextSheetName
                End With 
            End With

So I create a module and combine the codes together ?

Function NextSheetName() As String
    Const Prefix As String = "MySheet"
    Dim oneSheet As Worksheet
    Dim MaxName As Long
    For Each oneSheet In ThisWorkbook.Worksheets
        With oneSheet
            If .Name Like Prefix & "*" Then
                MaxName = WorksheetFunction.Max(0, Replace(.Name, Prefix, vbNullString))
            End If
        End With
    Next oneSheet
    NextSheetName = Prefix & (MaxName + 1)
    With .Parent.Parent
    With .Worksheets.Add(after:=.Sheets(.Sheets.Count), Type:=xlWorksheet)
        Range(topCell, bottomCell).EntireRow.Copy Destination:=.Range("A1")
        .Name = NextSheetName
    End With
End With

[xboon_95]

Sorry but I'm not too sure about the use of "modules" in VBA. How does it work?

[xboon_95]

You can standardize the sheet names (MySheet1, MySheet2, MySheet3, etc.).

Put this UDF into the same module as test

Function NextSheetName() As String
    Const Prefix As String = "MySheet"
    Dim oneSheet As Worksheet
    Dim MaxName As Long
    For Each oneSheet In ThisWorkbook.Worksheets
        With oneSheet
            If .Name Like Prefix & "*" Then
                MaxName = WorksheetFunction.Max(0, Replace(.Name, Prefix, vbNullString))
            End If
        End With
    Next oneSheet
    NextSheetName = Prefix & (MaxName + 1)
End Function

And add one line to test

            With .Parent.Parent 
                With .Worksheets.Add(after:=.Sheets(.Sheets.Count), Type:=xlWorksheet) 
                    Range(topCell, bottomCell).EntireRow.Copy Destination:=.Range("A1")
                    .Name = NextSheetName
                End With 
            End With

Hey dude ! Your code is awesome. Just that I just want one sheet to contain 1 string of " ¯ Starting Leak Checking(negative pressure)..." and its data. For instance,

¯ Starting Leak Checking(negative pressure)... ("Sheet1")

00:00:00 00:00:01 L -86 1 115
00:00:00 00:00:02 L -80 2 123
00:00:00 00:00:03 L -90 2 122
00:00:00 00:00:04 O -98 2 156
00:00:00 00:00:05 P -104 2 135
00:00:00 00:00:06 L 5 1 453
00:00:00 00:00:07 L 10 2 123


¯ Starting Leak Checking(negative pressure)... ("Sheet2")

00:00:01 00:00:01 L -87 1 117
00:00:02 00:00:02 P -86 1 154
00:00:03 00:00:03 O -91 2 167
00:00:04 00:00:04 O -98 2 156
00:00:05 00:00:05 P -104 2 135
00:00:06 00:00:06 L 7 1 453
00:00:07 00:00:07 L 10 2 127

¯ Starting Leak Checking(negative pressure)... ("Sheet3")
00:00:08 00:00:01 L -87 1 117
00:00:09 00:00:02 P -86 1 154
00:00:10 00:00:03 O -91 2 167
00:00:11 00:00:04 O -98 2 156
00:00:12 00:00:05 P -104 2 135
00:00:13 00:00:06 L 7 1 453
00:00:14 00:00:07 L 10 2 127

¯ Starting Leak Checking(negative pressure)... ("Sheet4")
00:00:15 00:00:01 L -87 1 117
00:00:16 00:00:02 P -86 1 154
00:00:17 00:00:03 O -91 2 167
00:00:18 00:00:04 O -98 2 156
00:00:19 00:00:05 P -104 2 135
00:00:20 00:00:06 L 7 1 453
00:00:21 00:00:07 L 10 2 127

The problem that I'm facing now is that "Sheet1" still contains the above 4 strings with its data. I just want the first string and its data to be in "Sheet1". The rest are good. Your help will be much appreciated. Thank you.

[xboon_95]

Hi, any idea on solving this problem?

[mikerickson]

Perhaps if you change this section.

With .Parent.Parent 
    With .Worksheets.Add(after:=.Sheets(.Sheets.Count), Type:=xlWorksheet) 
        With Range(topCell, bottomCell).EntireRow
            .Copy Destination:=.Range("A1")
            .ClearContents
         End With 
    End With
End With