 |
 | Home | Contact Us | FAQ | Search & Site Map | Link to Us |
 | Sign In | Join | Other 45 Sites in Network |
| HomeDiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWordDirectoryUser Groups Related Topics Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ... |
MS Office Forum / Excel / New Users / July 2007Searching for text?
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 >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 [quoted text clipped - 12 lines] > >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 > >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 [quoted text clipped - 55 lines] > > --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 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 [quoted text clipped - 82 lines] > > Regards 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 [quoted text clipped - 106 lines] >> >> Regards 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. [quoted text clipped - 111 lines] >>> >>> Regards 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 [quoted text clipped - 119 lines] >>>> >>>> Regards 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. > [quoted text clipped - 126 lines] >>>>> >>>>> Regards > 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 [quoted text clipped - 106 lines] > > > > 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 >> I am not trying to redirect you away from Ron's solution (it is just that >> I [quoted text clipped - 25 lines] > 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 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 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 [quoted text clipped - 106 lines] >> >> Regards >> >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 [quoted text clipped - 76 lines] > >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 > >> >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 [quoted text clipped - 119 lines] > > --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 >> >> >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 [quoted text clipped - 127 lines] > >Regards Yes, I caught that. See the subsequent post from me. --ron >> >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 [quoted text clipped - 76 lines] > >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 > >> >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 [quoted text clipped - 119 lines] > =============================================== > --ron Thank you This tests ok. I will try it out for real tomorrow. Regards >Thank you > >This tests ok. I will try it out for real tomorrow. > >Regards You're welcome. Let me know. --ron > >Thank you > > [quoted text clipped - 4 lines] > You're welcome. Let me know. > --ron The routine works ok, in fact too well. It it outputs more than I need. Can it be filtered to output certain stings in the quotation marks. i.e. only strings beginning with the 4 designated letters PART "partxxxxxxxxxxxxxxx" Regards >> >Thank you >> > [quoted text clipped - 13 lines] > >Regards That's merely a matter of changing sPattern and probably, based on your example, setting ignorecase to TRUE. e.g. Const sPattern As String = """(PART[^""]+)""" and below Set oRegex = CreateObject("VBScript.Regexp") With oRegex .Global = True .Pattern = sPattern .IgnoreCase = True End With --ron 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  SignatureDon Guillett Microsoft MVP Excel SalesAid Software dguillett1@austin.rr.com >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 [quoted text clipped - 12 lines] > > Regards >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 [quoted text clipped - 10 lines] > 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
|
Reply to this Message |
 Sign In
 Join
 My Latest Posts My Monitored Threads My Blog My Photo Gallery My Profile My Homepage Start New Thread Enable EMail Alerts Rate this Thread
|
©2008 Advenet LLC Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.