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? :crying:

[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