Need VBA to locate two specific characters the first time they appear together in the data and enter all data that precedes those two specified charac

[skyport]

If I use the paragraph below as an example, the two specific characters to look for would be the first time there is a period (.) followed by a space. In the example below, those characters together occur once around the middle of the paragraph and at the end as well.

Example Paragraph:
Need VBA to locate two specific characters the first time they appear together in different paragraphs in column A. It would then enter all data that comes before those two specified characters to another column-B. Thanks.

The idea behind what is needed for the code to do the job would be to find that first occurrence of the two characters within that paragraph in Column A and then enter all the data that comes before those two characters in that paragraph and enter the result in the next column -B in a cell by itself.

Using the above example paragraph, the result in a cell by itself in column B would be as follows:

Need VBA to locate two specific characters the first time they appear together in different paragraphs in column A.

The result is the data in the paragraph from column A only up to the first occurrence of those two characters together is entered in a cell by itself in column B. The code should then repeat that process for each subsequent paragraph in column A using a separate cell in column B for each result. Note: Every paragraph would be separated from the paragraph above and below with a blank line.

 

[ask2tsp]

using a separate cell in column B for each result.

Do you want each result on a different row, shifting rows down?

 

[skyport]

Hi and thanks for helping. Each result would be in a different cell/row of column B, first result in cell 1, then next in cell 2 etc.

 

[ask2tsp]

Try this
In the sheet with all the paragraphs. Start vba (press ALT+F11)
double-click the sheetname in the project explorer pane; the code window opens. Paste the following code in this window.

The sub expects to find a cell on the sheet Named 'splitString' that contains the string to split by.

Option Explicit

Sub splitParagraphs()
'paragraphs (a cel of text) in column A are split into fragments at splitpoints
'defined by a string

   Dim splitChars As String
   Dim lastRow    As Long
   Dim splitPoint As Integer
   Dim pt      As String
   Dim shtRow  As Long
   
   'get the characters to split by from the sheet
   splitChars = Me.Range("splitString")
   
   'erase result column
   Me.Range("B:B").ClearContents
   
   lastRow = Me.Cells(Me.Rows.Count, 1).End(xlUp).Row
   
   shtRow = 2
   Do Until shtRow > lastRow
      pt = Me.Cells(shtRow, 1).Value
      Do Until pt = ""
         splitPoint = InStr(1, pt, splitChars)
         If splitPoint = 0 Then
            Me.Cells(shtRow, 2).Value = pt
            pt = ""
         Else
            Me.Cells(shtRow, 2).Value = Left(pt, splitPoint + 1)
            pt = Mid(pt, splitPoint + 2)
            shtRow = shtRow + 1
            If Me.Cells(shtRow + 1, 1).Value > "" Then _
               Me.Cells(shtRow, 1).EntireRow.Insert
            lastRow = lastRow + 1
         End If
      Loop
      shtRow = shtRow + 1
   Loop
End Sub

 

[skyport]

I gave it a try right away and received a compile error: Invalid use of Mekeyword. The word Me was highlighted in the module after it happened. If it is of any help, in column A, each paragraph of data is in its own cell and then the next cell would be a blank creating a space between paragraphs followed by another paragraph in another cell. So, column A would look something like this:

Row

1 data paragraph
2 blank cell
3 data paragraph
4 blank cell
5 data paragraph
etc. etc. etc.

 

[ask2tsp]

Did you paste the code in the code page of the sheet that has the data paragraphs?
It looks like you pasted it into a module.
If you are not sure, I can change the code to make it work inside a module, but then I need the name of the data sheet.

Are these two delimiter characters always '. ' ? If yes it's better to put that in the code.

 

[skyport]

Thanks so much for helping on this. I did put it in the module. It would be great if you can make it work from a module. the name of the page would be headlines. The two characters are always THE FIRST OCCURRENCE ONLY of '. ' within each separate paragraph.

 

[ask2tsp]

Ok, now you can run it from a module, it works on text on worksheet 'headlines' and puts the text from the start to the first '. ' inclusive in column B

Sub splitParagraphs()
'paragraphs (a cel of text) in column A are split into fragments at splitpoints
'defined by a string

   Dim sht        As Worksheet
   Dim splitChars As String
   Dim lastRow    As Long
   Dim splitPoint As Integer
   Dim pt      As String
   Dim shtRow  As Long
   
   'get the characters to split by from the sheet
   'splitChars = Me.Range("splitString")
   splitChars = ". "
   
   Set sht = ThisWorkbook.Worksheets("headlines")
   
   'erase result column
   sht.Range("B:B").ClearContents
   
   lastRow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row
   
   shtRow = 2
   Do Until shtRow > lastRow
      pt = sht.Cells(shtRow, 1).Value
      If pt > "" Then
         splitPoint = InStr(1, pt, splitChars)
         If splitPoint = 0 Then
            sht.Cells(shtRow, 2).Value = pt
         Else
            sht.Cells(shtRow, 2).Value = Left(pt, splitPoint + 1)
         End If
      End If
      shtRow = shtRow + 1
   Loop
End Sub

 

[skyport]

Really good!!! It works almost perfect and lightning fast. The only flaw is for some reason it misses row 1 and actually starts the process it looks like with the data in row 3 because row 2 is blank of course. Is there a way to get it to include row 1 in the process? If so it would me a masterpiece of perfection

 

[Rick Rothstein]

Here is another way to write the macro (I renamed it to FirstSentence because that seems more descriptive to me) which seems to execute faster (tested on 1500 cells... ask2tsp code - 0.6 seconds, the code below - 0.2 seconds)...

[table="width: 500"]
[tr]
	[td]Sub FirstSentence()
  Dim lastRow As Long, splitChars As String
  'get the characters to split by from the sheet
  'splitChars = Me.Range("splitString")
  splitChars = ". "
  With Sheets("headlines")
    lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    .Range("B1:B" & lastRow) = Evaluate(Replace(Replace("IF(@A1:A#="""","""",LEFT(@A1:A#,FIND("". "",@A1:A#&"". "")))", "#", lastRow), "@", .Name & "!"))
  End With
End Sub[/td]
[/tr]
[/table]