Searching for text?

[newman]

I wish to search a block of text in a cell for any strings of text
within double quotation marks and put this string in a new column. If
there are more than one set of quotation marks then the subsequent
strings should be put in the next row. Is this possible?

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxxxxx def



xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

 

[Ron Rosenfeld]

I wish to search a block of text in a cell for any strings of text
within double quotation marks and put this string in a new column. If
there are more than one set of quotation marks then the subsequent
strings should be put in the next row. Is this possible?

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxxxxx def



xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

It appears, from your example, as if you also want to put one or more blank
rows between each set of entries.

Here's one way using a macro.

To enter the macro, <alt-F11> opens the VB Editor. Ensure your project is
highlighted in the project explorer window, then Insert/Module and paste the
code below into the window that opens.

To use the macro, select the range you wish to process. Ensure the column next
to this range is blank. (There are a variety of ways to do this
programmatically, but I don't have enough information to know which would be
suitable).

<alt-F8> opens the macro dialog box. Select the macro and <Run>.

=====================================================
Option Explicit
Sub SplitQuoted()
Dim c As Range
Dim i As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = "[^""]*[""]([^""]*)[""]"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern

For Each c In Selection
If oRegex.Test(c.Text) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
c.Offset(1, 0).Resize(mcMatchCollection.Count, 2).Insert (xlShiftDown)
For i = 0 To mcMatchCollection.Count - 1
c.Offset(i, 1).Value = mcMatchCollection(i).SubMatches(0)
Next i
End If
Next c
End Sub
==========================================================


--ron

 

[Don Guillett]

This should do it for the 1st criteria assuming your strings in col I

Sub extracttext()
lr = Cells(Rows.Count, "i").End(xlUp).Row
For Each c In Range("i2:i" & lr)
s1 = Application.Search("""", c, 1) + 1
s2 = Application.Search("""", c, s1 + 1)
'MsgBox Mid(c, s1, s2 - s1)
c.Offset(, 1) = Mid(c, s1, s2 - s1)
Next c
End Sub

 

[Rick Rothstein \(MVP - VB\)]

I wish to search a block of text in a cell for any strings of text

within double quotation marks and put this string in a new column. If
there are more than one set of quotation marks then the subsequent
strings should be put in the next row. Is this possible?

e.g..

xxxxxx"abc"xxxx abc

xxx"def"xxxxxxxxxxx def

xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk

This subroutine will take the text from whatever cell is passed into it,
find the text in quotes and put it/them in the next column starting at the
same row as the cell you passed into it...

Sub GetQuotedText(Rng As Range)
Dim X As Long
Dim QuotedText() As String
If Rng.Count > 1 Then Exit Sub
QuotedText = Split(Rng.Value, """")
For X = 1 To UBound(QuotedText) Step 2
Rng.Offset((X - 1) / 2, 1).Value = QuotedText(X)
Next
End Sub


Rick

 

[newman]

I wish to search a block of text in a cell for any strings of text
within double quotation marks and put this string in a new column. If
there are more than one set of quotation marks then the subsequent
strings should be put in the next row. Is this possible?

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxxxxx def



xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

It appears, from your example, as if you also want to put one or more blank
rows between each set of entries.

Here's one way using a macro.

To enter the macro, <alt-F11> opens the VB Editor. Ensure your project is
highlighted in the project explorer window, then Insert/Module and paste the
code below into the window that opens.

To use the macro, select the range you wish to process. Ensure the column next
to this range is blank. (There are a variety of ways to do this
programmatically, but I don't have enough information to know which would be
suitable).

<alt-F8> opens the macro dialog box. Select the macro and <Run>.

=====================================================
Option Explicit
Sub SplitQuoted()
Dim c As Range
Dim i As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = "[^""]*[""]([^""]*)[""]"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern

For Each c In Selection
If oRegex.Test(c.Text) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
c.Offset(1, 0).Resize(mcMatchCollection.Count, 2).Insert (xlShiftDown)
For i = 0 To mcMatchCollection.Count - 1
c.Offset(i, 1).Value = mcMatchCollection(i).SubMatches(0)
Next i
End If
Next c
End Sub
==========================================================

--ron

Thank you

This is exactly what I require.

Next question. Occasionally there is a sting duplicated within the block
of text. Is there a way to avoid that string being displayed twice in
the second column? It is not so important but would be neater.

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxx"def"xxx def
def < not required


xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

 

[Rick Rothstein \(MVP - VB\)]

I am not trying to redirect you away from Ron's solution (it is just that I
am more familiar with the code I wrote); but if you think you can make use
of the approach I took to your problem, then here is a modification to the
subroutine I posted that eliminates duplicates...

Sub GetQuotedText(Rng As Range)
Dim X As Long
Dim Index As Long
Dim QuotedText() As String
Dim PlacedText() As String
If Rng.Count > 1 Then Exit Sub
QuotedText = Split(Rng.Value, """")
ReDim PlacedText(UBound(QuotedText))
For X = 1 To UBound(QuotedText) Step 2
If UBound(Filter(PlacedText, QuotedText(X))) = -1 Then
PlacedText(X) = QuotedText(X)
Rng.Offset(Index, 1).Value = QuotedText(X)
Index = Index + 1
End If
Next
End Sub

Rick

I wish to search a block of text in a cell for any strings of text
within double quotation marks and put this string in a new column. If
there are more than one set of quotation marks then the subsequent
strings should be put in the next row. Is this possible?

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxxxxx def



xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

It appears, from your example, as if you also want to put one or more
blank
rows between each set of entries.

Here's one way using a macro.

To enter the macro, <alt-F11> opens the VB Editor. Ensure your project
is
highlighted in the project explorer window, then Insert/Module and paste
the
code below into the window that opens.

To use the macro, select the range you wish to process. Ensure the
column next
to this range is blank. (There are a variety of ways to do this
programmatically, but I don't have enough information to know which would
be
suitable).

<alt-F8> opens the macro dialog box. Select the macro and <Run>.

=====================================================
Option Explicit
Sub SplitQuoted()
Dim c As Range
Dim i As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = "[^""]*[""]([^""]*)[""]"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern

For Each c In Selection
If oRegex.Test(c.Text) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
c.Offset(1, 0).Resize(mcMatchCollection.Count, 2).Insert
(xlShiftDown)
For i = 0 To mcMatchCollection.Count - 1
c.Offset(i, 1).Value = mcMatchCollection(i).SubMatches(0)
Next i
End If
Next c
End Sub
==========================================================

--ron

Thank you

This is exactly what I require.

Next question. Occasionally there is a sting duplicated within the block
of text. Is there a way to avoid that string being displayed twice in
the second column? It is not so important but would be neater.

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxx"def"xxx def
def < not required


xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

 

[kounoike]

I think your code eliminates duplicates for sure, but might eliminate what
is needed also.

keizi

I am not trying to redirect you away from Ron's solution (it is just that I
am more familiar with the code I wrote); but if you think you can make use
of the approach I took to your problem, then here is a modification to the
subroutine I posted that eliminates duplicates...

Sub GetQuotedText(Rng As Range)
Dim X As Long
Dim Index As Long
Dim QuotedText() As String
Dim PlacedText() As String
If Rng.Count > 1 Then Exit Sub
QuotedText = Split(Rng.Value, """")
ReDim PlacedText(UBound(QuotedText))
For X = 1 To UBound(QuotedText) Step 2
If UBound(Filter(PlacedText, QuotedText(X))) = -1 Then
PlacedText(X) = QuotedText(X)
Rng.Offset(Index, 1).Value = QuotedText(X)
Index = Index + 1
End If
Next
End Sub

Rick

I wish to search a block of text in a cell for any strings of text
within double quotation marks and put this string in a new column. If
there are more than one set of quotation marks then the subsequent
strings should be put in the next row. Is this possible?

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxxxxx def



xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

It appears, from your example, as if you also want to put one or more
blank
rows between each set of entries.

Here's one way using a macro.

To enter the macro, <alt-F11> opens the VB Editor. Ensure your project
is
highlighted in the project explorer window, then Insert/Module and paste
the
code below into the window that opens.

To use the macro, select the range you wish to process. Ensure the
column next
to this range is blank. (There are a variety of ways to do this
programmatically, but I don't have enough information to know which
would be
suitable).

<alt-F8> opens the macro dialog box. Select the macro and <Run>.

=====================================================
Option Explicit
Sub SplitQuoted()
Dim c As Range
Dim i As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = "[^""]*[""]([^""]*)[""]"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern

For Each c In Selection
If oRegex.Test(c.Text) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
c.Offset(1, 0).Resize(mcMatchCollection.Count, 2).Insert
(xlShiftDown)
For i = 0 To mcMatchCollection.Count - 1
c.Offset(i, 1).Value = mcMatchCollection(i).SubMatches(0)
Next i
End If
Next c
End Sub
==========================================================

--ron

Thank you

This is exactly what I require.

Next question. Occasionally there is a sting duplicated within the block
of text. Is there a way to avoid that string being displayed twice in
the second column? It is not so important but would be neater.

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxx"def"xxx def
def < not required


xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

 

[Ron Rosenfeld]

I wish to search a block of text in a cell for any strings of text
within double quotation marks and put this string in a new column. If
there are more than one set of quotation marks then the subsequent
strings should be put in the next row. Is this possible?

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxxxxx def



xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

It appears, from your example, as if you also want to put one or more blank
rows between each set of entries.

Here's one way using a macro.

To enter the macro, <alt-F11> opens the VB Editor. Ensure your project is
highlighted in the project explorer window, then Insert/Module and paste the
code below into the window that opens.

To use the macro, select the range you wish to process. Ensure the column next
to this range is blank. (There are a variety of ways to do this
programmatically, but I don't have enough information to know which would be
suitable).

<alt-F8> opens the macro dialog box. Select the macro and <Run>.

=====================================================
Option Explicit
Sub SplitQuoted()
Dim c As Range
Dim i As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = "[^""]*[""]([^""]*)[""]"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern

For Each c In Selection
If oRegex.Test(c.Text) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
c.Offset(1, 0).Resize(mcMatchCollection.Count, 2).Insert (xlShiftDown)
For i = 0 To mcMatchCollection.Count - 1
c.Offset(i, 1).Value = mcMatchCollection(i).SubMatches(0)
Next i
End If
Next c
End Sub
==========================================================

--ron

Thank you

This is exactly what I require.

Next question. Occasionally there is a sting duplicated within the block
of text. Is there a way to avoid that string being displayed twice in
the second column? It is not so important but would be neater.

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxx"def"xxx def
def < not required


xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

Try this modification:

============================================
Option Explicit
Sub SplitQuoted()
Dim c As Range
Dim i As Long, j As Long, k As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = "(""[^""]+"")"
Dim vTemp() As Variant

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern

For Each c In Selection
k = 0
If oRegex.Test(c.Text) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
For i = 0 To mcMatchCollection.Count - 1
For j = mcMatchCollection.Count - 1 To i Step -1
If mcMatchCollection(j) = mcMatchCollection(i) Then
Exit For
End If
Next j
If j = i Then
ReDim Preserve vTemp(k)
vTemp(k) = mcMatchCollection(i)
k = k + 1
End If
Next i
c.Offset(1, 0).Resize(UBound(vTemp) + 1, 2).Insert (xlShiftDown)
For i = 0 To UBound(vTemp)
c.Offset(i, 1).Value = vTemp(i)
Next i
End If
Next c
End Sub
====================================================

--ron

 

[newman]

I am not trying to redirect you away from Ron's solution (it is just that I
am more familiar with the code I wrote); but if you think you can make use
of the approach I took to your problem, then here is a modification to the
subroutine I posted that eliminates duplicates...

Sub GetQuotedText(Rng As Range)
Dim X As Long
Dim Index As Long
Dim QuotedText() As String
Dim PlacedText() As String
If Rng.Count > 1 Then Exit Sub
QuotedText = Split(Rng.Value, """")
ReDim PlacedText(UBound(QuotedText))
For X = 1 To UBound(QuotedText) Step 2
If UBound(Filter(PlacedText, QuotedText(X))) = -1 Then
PlacedText(X) = QuotedText(X)
Rng.Offset(Index, 1).Value = QuotedText(X)
Index = Index + 1
End If
Next
End Sub

Rick

I wish to search a block of text in a cell for any strings of text
within double quotation marks and put this string in a new column. If
there are more than one set of quotation marks then the subsequent
strings should be put in the next row. Is this possible?

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxxxxx def



xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

It appears, from your example, as if you also want to put one or more
blank
rows between each set of entries.

Here's one way using a macro.

To enter the macro, <alt-F11> opens the VB Editor. Ensure your project
is
highlighted in the project explorer window, then Insert/Module and paste
the
code below into the window that opens.

To use the macro, select the range you wish to process. Ensure the
column next
to this range is blank. (There are a variety of ways to do this
programmatically, but I don't have enough information to know which would
be
suitable).

<alt-F8> opens the macro dialog box. Select the macro and <Run>.

=====================================================
Option Explicit
Sub SplitQuoted()
Dim c As Range
Dim i As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = "[^""]*[""]([^""]*)[""]"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern

For Each c In Selection
If oRegex.Test(c.Text) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
c.Offset(1, 0).Resize(mcMatchCollection.Count, 2).Insert
(xlShiftDown)
For i = 0 To mcMatchCollection.Count - 1
c.Offset(i, 1).Value = mcMatchCollection(i).SubMatches(0)
Next i
End If
Next c
End Sub
==========================================================

--ron

Thank you

This is exactly what I require.

Next question. Occasionally there is a sting duplicated within the block
of text. Is there a way to avoid that string being displayed twice in
the second column? It is not so important but would be neater.

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxx"def"xxx def
def < not required


xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

Rick

I must be doing something wrong. When I paste your code into a new
module and try to run the macro there is nothing in the macro list.
Ron's routine works ok.

Regards

 

[newman]

I wish to search a block of text in a cell for any strings of text
within double quotation marks and put this string in a new column. If
there are more than one set of quotation marks then the subsequent
strings should be put in the next row. Is this possible?

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxxxxx def



xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

It appears, from your example, as if you also want to put one or more blank
rows between each set of entries.

Here's one way using a macro.

To enter the macro, <alt-F11> opens the VB Editor. Ensure your project is
highlighted in the project explorer window, then Insert/Module and paste the
code below into the window that opens.

To use the macro, select the range you wish to process. Ensure the column next
to this range is blank. (There are a variety of ways to do this
programmatically, but I don't have enough information to know which would be
suitable).

<alt-F8> opens the macro dialog box. Select the macro and <Run>.

=====================================================
Option Explicit
Sub SplitQuoted()
Dim c As Range
Dim i As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = "[^""]*[""]([^""]*)[""]"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern

For Each c In Selection
If oRegex.Test(c.Text) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
c.Offset(1, 0).Resize(mcMatchCollection.Count, 2).Insert (xlShiftDown)
For i = 0 To mcMatchCollection.Count - 1
c.Offset(i, 1).Value = mcMatchCollection(i).SubMatches(0)
Next i
End If
Next c
End Sub
==========================================================

--ron

Thank you

This is exactly what I require.

Next question. Occasionally there is a sting duplicated within the block
of text. Is there a way to avoid that string being displayed twice in
the second column? It is not so important but would be neater.

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxx"def"xxx def
def < not required


xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

Try this modification:

============================================
Option Explicit
Sub SplitQuoted()
Dim c As Range
Dim i As Long, j As Long, k As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = "(""[^""]+"")"
Dim vTemp() As Variant

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern

For Each c In Selection
k = 0
If oRegex.Test(c.Text) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
For i = 0 To mcMatchCollection.Count - 1
For j = mcMatchCollection.Count - 1 To i Step -1
If mcMatchCollection(j) = mcMatchCollection(i) Then
Exit For
End If
Next j
If j = i Then
ReDim Preserve vTemp(k)
vTemp(k) = mcMatchCollection(i)
k = k + 1
End If
Next i
c.Offset(1, 0).Resize(UBound(vTemp) + 1, 2).Insert (xlShiftDown)
For i = 0 To UBound(vTemp)
c.Offset(i, 1).Value = vTemp(i)
Next i
End If
Next c
End Sub
====================================================

--ron

Thanks Ron

Module 2 works with one small problem. Your first routine does not show
the quotation marks in the output. Your second routine shows the
quotation marks, which is not quite what I require.

Regards

 

[Rick Rothstein \(MVP - VB\)]

I am not trying to redirect you away from Ron's solution (it is just that

I must be doing something wrong. When I paste your code into a new
module and try to run the macro there is nothing in the macro list.

My subroutine is not listed as a macro because it needs an argument passed
to it (which makes it a plain subroutine). I envisioned that you would be
using a Command Button or some worksheet event procedure to kick off the
code as opposed to simply running it from the Macro dialog. If you called it
from a Command Button's Click event or from within an event procedure, your
call would look like this...

GetQuotedText Range("A1")

or by using the currently selected cell...

GetQuotedText Selection

The subroutine only processes a single cell (that is where it differs from
Ron's), so if you specify a range containing more than one cell, the
subroutine won't do anything. If you want to be able to run it from the
dialog against the currently selected cell, try using this code instead...

Sub GetQuotedText()
Dim X As Long
Dim Index As Long
Dim QuotedText() As String
Dim PlacedText() As String
If Selection.Count > 1 Then Exit Sub
QuotedText = Split(Selection.Value, """")
If UBound(QuotedText) = -1 Then Exit Sub
ReDim PlacedText(UBound(QuotedText))
For X = 1 To UBound(QuotedText) Step 2
If UBound(Filter(PlacedText, QuotedText(X))) = -1 Then
PlacedText(X) = QuotedText(X)
Selection.Offset(Index, 1).Value = QuotedText(X)
Index = Index + 1
End If
Next
End Sub

Now it should appear in the Macro list. As with Ron's code, select the cell
you want to process and then execute the macro.

Note: I added an If-Then test immediately after the assignment line to
QuotedText in order to halt an error message that happens if a empty cell is
processed. If you chose to use my routine as originally designed (with the
argument), you should add this line in the same location to that orignal
code (for the same reason I added it here).

Ron's routine works ok.

Which may be a reason to simply forget about my code and use his. It is more
flexible in that it will add rows to your spreadsheet in order to
accommodate the list it produces. I offered my solution, not only because it
used a non-RegEx approach, but also because it didn't affect the spreadsheet
by adding additional rows. Your original post wasn't clear if you wanted to
do that or not.


Rick

 

[Ron Rosenfeld]

I wish to search a block of text in a cell for any strings of text
within double quotation marks and put this string in a new column. If
there are more than one set of quotation marks then the subsequent
strings should be put in the next row. Is this possible?

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxxxxx def



xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

It appears, from your example, as if you also want to put one or more blank
rows between each set of entries.

Here's one way using a macro.

To enter the macro, <alt-F11> opens the VB Editor. Ensure your project is
highlighted in the project explorer window, then Insert/Module and paste the
code below into the window that opens.

To use the macro, select the range you wish to process. Ensure the column next
to this range is blank. (There are a variety of ways to do this
programmatically, but I don't have enough information to know which would be
suitable).

<alt-F8> opens the macro dialog box. Select the macro and <Run>.

=====================================================
Option Explicit
Sub SplitQuoted()
Dim c As Range
Dim i As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = "[^""]*[""]([^""]*)[""]"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern

For Each c In Selection
If oRegex.Test(c.Text) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
c.Offset(1, 0).Resize(mcMatchCollection.Count, 2).Insert (xlShiftDown)
For i = 0 To mcMatchCollection.Count - 1
c.Offset(i, 1).Value = mcMatchCollection(i).SubMatches(0)
Next i
End If
Next c
End Sub
==========================================================

--ron

Thank you

This is exactly what I require.

Next question. Occasionally there is a sting duplicated within the block
of text. Is there a way to avoid that string being displayed twice in
the second column? It is not so important but would be neater.

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxx"def"xxx def
def < not required


xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

Small oops in the last iteration. In simplifying sPattern I wound up including
the quote marks in the return. This corrects that:

=========================================================
Sub SplitQuoted()
Dim c As Range
Dim i As Long, j As Long, k As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = """([^""]+)"""
Dim vTemp() As Variant

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern

For Each c In Selection
k = 0
If oRegex.Test(c.Text) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
For i = 0 To mcMatchCollection.Count - 1
For j = mcMatchCollection.Count - 1 To i Step -1
If mcMatchCollection(j).SubMatches(0) = _
mcMatchCollection(i).SubMatches(0) Then
Exit For
End If
Next j
If j = i Then
ReDim Preserve vTemp(k)
vTemp(k) = mcMatchCollection(i).SubMatches(0)
k = k + 1
End If
Next i
c.Offset(1, 0).Resize(UBound(vTemp) + 1, 2).Insert (xlShiftDown)
For i = 0 To UBound(vTemp)
c.Offset(i, 1).Value = vTemp(i)
Next i
End If
Next c
End Sub
===============================================
--ron

 

[Ron Rosenfeld]

Ron Rosenfeld wrote:


I wish to search a block of text in a cell for any strings of text
within double quotation marks and put this string in a new column. If
there are more than one set of quotation marks then the subsequent
strings should be put in the next row. Is this possible?

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxxxxx def



xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

It appears, from your example, as if you also want to put one or more blank
rows between each set of entries.

Here's one way using a macro.

To enter the macro, <alt-F11> opens the VB Editor. Ensure your project is
highlighted in the project explorer window, then Insert/Module and paste the
code below into the window that opens.

To use the macro, select the range you wish to process. Ensure the column next
to this range is blank. (There are a variety of ways to do this
programmatically, but I don't have enough information to know which would be
suitable).

<alt-F8> opens the macro dialog box. Select the macro and <Run>.

=====================================================
Option Explicit
Sub SplitQuoted()
Dim c As Range
Dim i As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = "[^""]*[""]([^""]*)[""]"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern

For Each c In Selection
If oRegex.Test(c.Text) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
c.Offset(1, 0).Resize(mcMatchCollection.Count, 2).Insert (xlShiftDown)
For i = 0 To mcMatchCollection.Count - 1
c.Offset(i, 1).Value = mcMatchCollection(i).SubMatches(0)
Next i
End If
Next c
End Sub
==========================================================

--ron

Thank you

This is exactly what I require.

Next question. Occasionally there is a sting duplicated within the block
of text. Is there a way to avoid that string being displayed twice in
the second column? It is not so important but would be neater.

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxx"def"xxx def
def < not required


xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

Try this modification:

============================================
Option Explicit
Sub SplitQuoted()
Dim c As Range
Dim i As Long, j As Long, k As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = "(""[^""]+"")"
Dim vTemp() As Variant

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern

For Each c In Selection
k = 0
If oRegex.Test(c.Text) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
For i = 0 To mcMatchCollection.Count - 1
For j = mcMatchCollection.Count - 1 To i Step -1
If mcMatchCollection(j) = mcMatchCollection(i) Then
Exit For
End If
Next j
If j = i Then
ReDim Preserve vTemp(k)
vTemp(k) = mcMatchCollection(i)
k = k + 1
End If
Next i
c.Offset(1, 0).Resize(UBound(vTemp) + 1, 2).Insert (xlShiftDown)
For i = 0 To UBound(vTemp)
c.Offset(i, 1).Value = vTemp(i)
Next i
End If
Next c
End Sub
====================================================

--ron

Thanks Ron

Module 2 works with one small problem. Your first routine does not show
the quotation marks in the output. Your second routine shows the
quotation marks, which is not quite what I require.

Regards

Yes, I caught that.

See the subsequent post from me.
--ron

 

[Rick Rothstein \(MVP - VB\)]

I'm not sure what you are referring to when you say it "might eliminate what
is needed also"... all the tests I did seem to indicate the code works fine.
Did you have a particular situation in mind that I might have missed?

Rick

I think your code eliminates duplicates for sure, but might eliminate what
is needed also.

keizi

I am not trying to redirect you away from Ron's solution (it is just that
I am more familiar with the code I wrote); but if you think you can make
use of the approach I took to your problem, then here is a modification to
the subroutine I posted that eliminates duplicates...

Sub GetQuotedText(Rng As Range)
Dim X As Long
Dim Index As Long
Dim QuotedText() As String
Dim PlacedText() As String
If Rng.Count > 1 Then Exit Sub
QuotedText = Split(Rng.Value, """")
ReDim PlacedText(UBound(QuotedText))
For X = 1 To UBound(QuotedText) Step 2
If UBound(Filter(PlacedText, QuotedText(X))) = -1 Then
PlacedText(X) = QuotedText(X)
Rng.Offset(Index, 1).Value = QuotedText(X)
Index = Index + 1
End If
Next
End Sub

Rick

Ron Rosenfeld wrote:


I wish to search a block of text in a cell for any strings of text
within double quotation marks and put this string in a new column. If
there are more than one set of quotation marks then the subsequent
strings should be put in the next row. Is this possible?

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxxxxx def



xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

It appears, from your example, as if you also want to put one or more
blank
rows between each set of entries.

Here's one way using a macro.

To enter the macro, <alt-F11> opens the VB Editor. Ensure your project
is
highlighted in the project explorer window, then Insert/Module and
paste the
code below into the window that opens.

To use the macro, select the range you wish to process. Ensure the
column next
to this range is blank. (There are a variety of ways to do this
programmatically, but I don't have enough information to know which
would be
suitable).

<alt-F8> opens the macro dialog box. Select the macro and <Run>.

=====================================================
Option Explicit
Sub SplitQuoted()
Dim c As Range
Dim i As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = "[^""]*[""]([^""]*)[""]"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern

For Each c In Selection
If oRegex.Test(c.Text) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
c.Offset(1, 0).Resize(mcMatchCollection.Count, 2).Insert
(xlShiftDown)
For i = 0 To mcMatchCollection.Count - 1
c.Offset(i, 1).Value = mcMatchCollection(i).SubMatches(0)
Next i
End If
Next c
End Sub
==========================================================

--ron

Thank you

This is exactly what I require.

Next question. Occasionally there is a sting duplicated within the block
of text. Is there a way to avoid that string being displayed twice in
the second column? It is not so important but would be neater.

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxx"def"xxx def
def < not required


xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

 

[newman]

I wish to search a block of text in a cell for any strings of text
within double quotation marks and put this string in a new column. If
there are more than one set of quotation marks then the subsequent
strings should be put in the next row. Is this possible?

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxxxxx def



xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

It appears, from your example, as if you also want to put one or more blank
rows between each set of entries.

Here's one way using a macro.

To enter the macro, <alt-F11> opens the VB Editor. Ensure your project is
highlighted in the project explorer window, then Insert/Module and paste the
code below into the window that opens.

To use the macro, select the range you wish to process. Ensure the column next
to this range is blank. (There are a variety of ways to do this
programmatically, but I don't have enough information to know which would be
suitable).

<alt-F8> opens the macro dialog box. Select the macro and <Run>.

=====================================================
Option Explicit
Sub SplitQuoted()
Dim c As Range
Dim i As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = "[^""]*[""]([^""]*)[""]"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern

For Each c In Selection
If oRegex.Test(c.Text) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
c.Offset(1, 0).Resize(mcMatchCollection.Count, 2).Insert (xlShiftDown)
For i = 0 To mcMatchCollection.Count - 1
c.Offset(i, 1).Value = mcMatchCollection(i).SubMatches(0)
Next i
End If
Next c
End Sub
==========================================================

--ron

Thank you

This is exactly what I require.

Next question. Occasionally there is a sting duplicated within the block
of text. Is there a way to avoid that string being displayed twice in
the second column? It is not so important but would be neater.

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxx"def"xxx def
def < not required


xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

Small oops in the last iteration. In simplifying sPattern I wound up including
the quote marks in the return. This corrects that:

=========================================================
Sub SplitQuoted()
Dim c As Range
Dim i As Long, j As Long, k As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = """([^""]+)"""
Dim vTemp() As Variant

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern

For Each c In Selection
k = 0
If oRegex.Test(c.Text) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
For i = 0 To mcMatchCollection.Count - 1
For j = mcMatchCollection.Count - 1 To i Step -1
If mcMatchCollection(j).SubMatches(0) = _
mcMatchCollection(i).SubMatches(0) Then
Exit For
End If
Next j
If j = i Then
ReDim Preserve vTemp(k)
vTemp(k) = mcMatchCollection(i).SubMatches(0)
k = k + 1
End If
Next i
c.Offset(1, 0).Resize(UBound(vTemp) + 1, 2).Insert (xlShiftDown)
For i = 0 To UBound(vTemp)
c.Offset(i, 1).Value = vTemp(i)
Next i
End If
Next c
End Sub
===============================================
--ron

Thank you

This tests ok. I will try it out for real tomorrow.


Regards

 

[kounoike]

something like this.

xxx"abc"xxxx"def"xxxx"ab"xxxxx

keizi

I'm not sure what you are referring to when you say it "might eliminate
what is needed also"... all the tests I did seem to indicate the code
works fine. Did you have a particular situation in mind that I might have
missed?

Rick

I think your code eliminates duplicates for sure, but might eliminate what
is needed also.

keizi

I am not trying to redirect you away from Ron's solution (it is just that
I am more familiar with the code I wrote); but if you think you can make
use of the approach I took to your problem, then here is a modification
to the subroutine I posted that eliminates duplicates...

Sub GetQuotedText(Rng As Range)
Dim X As Long
Dim Index As Long
Dim QuotedText() As String
Dim PlacedText() As String
If Rng.Count > 1 Then Exit Sub
QuotedText = Split(Rng.Value, """")
ReDim PlacedText(UBound(QuotedText))
For X = 1 To UBound(QuotedText) Step 2
If UBound(Filter(PlacedText, QuotedText(X))) = -1 Then
PlacedText(X) = QuotedText(X)
Rng.Offset(Index, 1).Value = QuotedText(X)
Index = Index + 1
End If
Next
End Sub

Rick


Ron Rosenfeld wrote:


I wish to search a block of text in a cell for any strings of text
within double quotation marks and put this string in a new column. If
there are more than one set of quotation marks then the subsequent
strings should be put in the next row. Is this possible?

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxxxxx def



xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

It appears, from your example, as if you also want to put one or more
blank
rows between each set of entries.

Here's one way using a macro.

To enter the macro, <alt-F11> opens the VB Editor. Ensure your
project is
highlighted in the project explorer window, then Insert/Module and
paste the
code below into the window that opens.

To use the macro, select the range you wish to process. Ensure the
column next
to this range is blank. (There are a variety of ways to do this
programmatically, but I don't have enough information to know which
would be
suitable).

<alt-F8> opens the macro dialog box. Select the macro and <Run>.

=====================================================
Option Explicit
Sub SplitQuoted()
Dim c As Range
Dim i As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = "[^""]*[""]([^""]*)[""]"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern

For Each c In Selection
If oRegex.Test(c.Text) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
c.Offset(1, 0).Resize(mcMatchCollection.Count, 2).Insert
(xlShiftDown)
For i = 0 To mcMatchCollection.Count - 1
c.Offset(i, 1).Value = mcMatchCollection(i).SubMatches(0)
Next i
End If
Next c
End Sub
==========================================================

--ron

Thank you

This is exactly what I require.

Next question. Occasionally there is a sting duplicated within the
block
of text. Is there a way to avoid that string being displayed twice in
the second column? It is not so important but would be neater.

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxx"def"xxx def
def < not required


xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

 

[Rick Rothstein \(MVP - VB\)]

Sigh! You know, I was burned by this very same oversight a little while ago
over in the compiled VB newsgroups and here I went and did it again! Thanks
very much for pointing that out.

Rick

something like this.

xxx"abc"xxxx"def"xxxx"ab"xxxxx

keizi

I'm not sure what you are referring to when you say it "might eliminate
what is needed also"... all the tests I did seem to indicate the code
works fine. Did you have a particular situation in mind that I might have
missed?

Rick

I think your code eliminates duplicates for sure, but might eliminate
what is needed also.

keizi

message I am not trying to redirect you away from Ron's solution (it is just
that I am more familiar with the code I wrote); but if you think you can
make use of the approach I took to your problem, then here is a
modification to the subroutine I posted that eliminates duplicates...

Sub GetQuotedText(Rng As Range)
Dim X As Long
Dim Index As Long
Dim QuotedText() As String
Dim PlacedText() As String
If Rng.Count > 1 Then Exit Sub
QuotedText = Split(Rng.Value, """")
ReDim PlacedText(UBound(QuotedText))
For X = 1 To UBound(QuotedText) Step 2
If UBound(Filter(PlacedText, QuotedText(X))) = -1 Then
PlacedText(X) = QuotedText(X)
Rng.Offset(Index, 1).Value = QuotedText(X)
Index = Index + 1
End If
Next
End Sub

Rick


Ron Rosenfeld wrote:


I wish to search a block of text in a cell for any strings of text
within double quotation marks and put this string in a new column.
If
there are more than one set of quotation marks then the subsequent
strings should be put in the next row. Is this possible?

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxxxxx def



xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

It appears, from your example, as if you also want to put one or more
blank
rows between each set of entries.

Here's one way using a macro.

To enter the macro, <alt-F11> opens the VB Editor. Ensure your
project is
highlighted in the project explorer window, then Insert/Module and
paste the
code below into the window that opens.

To use the macro, select the range you wish to process. Ensure the
column next
to this range is blank. (There are a variety of ways to do this
programmatically, but I don't have enough information to know which
would be
suitable).

<alt-F8> opens the macro dialog box. Select the macro and <Run>.

=====================================================
Option Explicit
Sub SplitQuoted()
Dim c As Range
Dim i As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = "[^""]*[""]([^""]*)[""]"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern

For Each c In Selection
If oRegex.Test(c.Text) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
c.Offset(1, 0).Resize(mcMatchCollection.Count, 2).Insert
(xlShiftDown)
For i = 0 To mcMatchCollection.Count - 1
c.Offset(i, 1).Value = mcMatchCollection(i).SubMatches(0)
Next i
End If
Next c
End Sub
==========================================================

--ron

Thank you

This is exactly what I require.

Next question. Occasionally there is a sting duplicated within the
block
of text. Is there a way to avoid that string being displayed twice in
the second column? It is not so important but would be neater.

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxx"def"xxx def
def < not required


xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

 

[Rick Rothstein \(MVP - VB\)]

My previously posted code had a minor flaw which 'kounoike' was kind enough
to point out. If you should decide to use my approach, you will have to use
this code instead...

User Selection Version
============================
Sub GetQuotedText()
Dim X As Long
Dim Index As Long
Dim QuotedText() As String
Dim PlacedText() As String
If Selection.Count > 1 Then Exit Sub
QuotedText = Split(Selection.Value, """")
If UBound(QuotedText) = -1 Then Exit Sub
ReDim PlacedText(UBound(QuotedText))
For X = 1 To UBound(QuotedText) Step 2
If UBound(Filter(PlacedText, Chr$(1) & _
QuotedText(X) & Chr$(1))) = -1 Then
PlacedText(X) = Chr$(1) & QuotedText(X) & Chr$(1)
Selection.Offset(Index, 1).Value = QuotedText(X)
Index = Index + 1
End If
Next
End Sub

With Argument Version
=============================
Sub GetQuotedText(Rng As Range)
Dim X As Long
Dim Index As Long
Dim QuotedText() As String
Dim PlacedText() As String
If Rng.Count > 1 Then Exit Sub
QuotedText = Split(Rng.Value, """")
If UBound(QuotedText) = -1 Then Exit Sub
ReDim PlacedText(UBound(QuotedText))
For X = 1 To UBound(QuotedText) Step 2
If UBound(Filter(PlacedText, Chr$(1) & _
QuotedText(X) & Chr$(1))) = -1 Then
PlacedText(X) = Chr$(1) & QuotedText(X) & Chr$(1)
Rng.Offset(Index, 1).Value = QuotedText(X)
Index = Index + 1
End If
Next
End Sub


Rick

 

[Rick Rothstein \(MVP - VB\)]

Just to keep the archive records straight, my previous post has a small flaw
which 'kounoike' was kind enough to point out. Here is a corrected
subroutine to replace it...

Sub GetQuotedText(Rng As Range)
Dim X As Long
Dim Index As Long
Dim QuotedText() As String
Dim PlacedText() As String
If Rng.Count > 1 Then Exit Sub
QuotedText = Split(Rng.Value, """")
If UBound(QuotedText) = -1 Then Exit Sub
ReDim PlacedText(UBound(QuotedText))
For X = 1 To UBound(QuotedText) Step 2
If UBound(Filter(PlacedText, Chr$(1) & _
QuotedText(X) & Chr$(1))) = -1 Then
PlacedText(X) = Chr$(1) & QuotedText(X) & Chr$(1)
Rng.Offset(Index, 1).Value = QuotedText(X)
Index = Index + 1
End If
Next
End Sub


Rick

I am not trying to redirect you away from Ron's solution (it is just that I
am more familiar with the code I wrote); but if you think you can make use
of the approach I took to your problem, then here is a modification to the
subroutine I posted that eliminates duplicates...

Sub GetQuotedText(Rng As Range)
Dim X As Long
Dim Index As Long
Dim QuotedText() As String
Dim PlacedText() As String
If Rng.Count > 1 Then Exit Sub
QuotedText = Split(Rng.Value, """")
ReDim PlacedText(UBound(QuotedText))
For X = 1 To UBound(QuotedText) Step 2
If UBound(Filter(PlacedText, QuotedText(X))) = -1 Then
PlacedText(X) = QuotedText(X)
Rng.Offset(Index, 1).Value = QuotedText(X)
Index = Index + 1
End If
Next
End Sub

Rick

I wish to search a block of text in a cell for any strings of text
within double quotation marks and put this string in a new column. If
there are more than one set of quotation marks then the subsequent
strings should be put in the next row. Is this possible?

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxxxxx def



xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

It appears, from your example, as if you also want to put one or more
blank
rows between each set of entries.

Here's one way using a macro.

To enter the macro, <alt-F11> opens the VB Editor. Ensure your project
is
highlighted in the project explorer window, then Insert/Module and paste
the
code below into the window that opens.

To use the macro, select the range you wish to process. Ensure the
column next
to this range is blank. (There are a variety of ways to do this
programmatically, but I don't have enough information to know which
would be
suitable).

<alt-F8> opens the macro dialog box. Select the macro and <Run>.

=====================================================
Option Explicit
Sub SplitQuoted()
Dim c As Range
Dim i As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = "[^""]*[""]([^""]*)[""]"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern

For Each c In Selection
If oRegex.Test(c.Text) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
c.Offset(1, 0).Resize(mcMatchCollection.Count, 2).Insert
(xlShiftDown)
For i = 0 To mcMatchCollection.Count - 1
c.Offset(i, 1).Value = mcMatchCollection(i).SubMatches(0)
Next i
End If
Next c
End Sub
==========================================================

--ron

Thank you

This is exactly what I require.

Next question. Occasionally there is a sting duplicated within the block
of text. Is there a way to avoid that string being displayed twice in
the second column? It is not so important but would be neater.

e.g..

xxxxxx"abc"xxxx abc


xxx"def"xxxxxxxx"def"xxx def
def < not required


xxx"abc"xxxx"def"xxxx"ghijk"xxxxxx abc
def
ghijk


Regards

 

[Ron Rosenfeld]

Thank you

This tests ok. I will try it out for real tomorrow.


Regards

You're welcome. Let me know.
--ron