VBA Code to extract Text btwn ">TEXT<" ?

**mave27** · 08-04-2015, 05:12 AM

Anyone care to share VBA code to extract out Text btwn ">TEXT<" on Col G of my worksheet ?

Below some examples of Case scenarious:

Input: Size 39*45*H(80-104)CM
Output: 39*45*H(80-104)CM

Input: X-style height adjustable keyboard/piano bench. 
Output: X-style height adjustable keyboard/piano bench.

Input: Generous sized 60 cm x 32 cm
Output: Generous sized 60 cm x 32 cm

Input: Generous sized 60 cm x 32 cm seat. Black finish.
Output: Generous sized 60 cm x 32 cm. seat. Black finish.

What to look for: >TEXT< AND omit ><

Note: Each Cell can have "multiple" instances of ">TEXT<" (in a single cell), as shown on Case Scenario #4

Thanks in Advance.

**Andy Pope** · 08-04-2015, 05:54 AM

Sub Test()

    Dim Text As String
    Dim OutText As String
    Dim Index As Long
    Dim StartPos As Long
    Dim BetweenBrackets As Boolean
    
    Text = ActiveCell.Value
    
    For Index = 1 To Len(Text)
        If Mid(Text, Index, 1) = ">" Then
            BetweenBrackets = True
            StartPos = Index
        ElseIf Mid(Text, Index, 1) = "<" Then
            If BetweenBrackets Then
                OutText = OutText & Mid(Text, StartPos + 1, Index - StartPos - 1)
            End If
            BetweenBrackets = False
        End If
    Next
    debug.print OutText
End Sub

Although for 1st example the result is,
Size 39*45*H(80-104)CM

**mave27** · 08-04-2015, 06:10 AM

Originally Posted by Andy Pope

Sub Test()

    Dim Text As String
    Dim OutText As String
    Dim Index As Long
    Dim StartPos As Long
    Dim BetweenBrackets As Boolean
    
    Text = ActiveCell.Value
    
    For Index = 1 To Len(Text)
        If Mid(Text, Index, 1) = ">" Then
            BetweenBrackets = True
            StartPos = Index
        ElseIf Mid(Text, Index, 1) = "<" Then
            If BetweenBrackets Then
                OutText = OutText & Mid(Text, StartPos + 1, Index - StartPos - 1)
            End If
            BetweenBrackets = False
        End If
    Next
    debug.print OutText
End Sub

Although for 1st example the result is,
Size 39*45*H(80-104)CM

Looks good, havent test it yet.

Just curious - i dont see anywhere in the code which Col it's referencing ? The data that needs cleaning up is on Col G. Can I get the output to Col H ?

**jindon** · 08-04-2015, 06:09 AM

......................

**Andy Pope** · 08-04-2015, 06:21 AM

The example just uses the active cell as input and outputs to immediate window.
You would need to specify in the code what cells it should be used on and where the result goes.

Function GetTextBetweenBrackets(Text As String) As String

    Dim OutText As String
    Dim Index As Long
    Dim StartPos As Long
    Dim BetweenBrackets As Boolean
    
    For Index = 1 To Len(Text)
        If Mid(Text, Index, 1) = ">" Then
            BetweenBrackets = True
            StartPos = Index
        ElseIf Mid(Text, Index, 1) = "<" Then
            If BetweenBrackets Then
                OutText = OutText & Mid(Text, StartPos + 1, Index - StartPos - 1)
            End If
            BetweenBrackets = False
        End If
    Next
    GetTextBetweenBrackets = OutText
    
End Function


Sub Test()

    Dim Data As Range
    Dim Cell As Range
    
    Set Data = Range("G1:G4")
    For Each Cell In Data.Cells
        Cell.Offset(0, 1) = GetTextBetweenBrackets(Cell.Value)
    Next
    
End Sub

**mave27** · 08-04-2015, 06:30 AM

Originally Posted by Andy Pope

The example just uses the active cell as input and outputs to immediate window.
You would need to specify in the code what cells it should be used on and where the result goes.

Function GetTextBetweenBrackets(Text As String) As String

    Dim OutText As String
    Dim Index As Long
    Dim StartPos As Long
    Dim BetweenBrackets As Boolean
    
    For Index = 1 To Len(Text)
        If Mid(Text, Index, 1) = ">" Then
            BetweenBrackets = True
            StartPos = Index
        ElseIf Mid(Text, Index, 1) = "<" Then
            If BetweenBrackets Then
                OutText = OutText & Mid(Text, StartPos + 1, Index - StartPos - 1)
            End If
            BetweenBrackets = False
        End If
    Next
    GetTextBetweenBrackets = OutText
    
End Function


Sub Test()

    Dim Data As Range
    Dim Cell As Range
    
    Set Data = Range("G1:G4")
    For Each Cell In Data.Cells
        Cell.Offset(0, 1) = GetTextBetweenBrackets(Cell.Value)
    Next
    
End Sub

Andy - thanks, thanks, thanks !!! Works like a magic wand !!

**mave27** · 08-04-2015, 06:41 AM

Originally Posted by Andy Pope

The example just uses the active cell as input and outputs to immediate window.
You would need to specify in the code what cells it should be used on and where the result goes.

Function GetTextBetweenBrackets(Text As String) As String

    Dim OutText As String
    Dim Index As Long
    Dim StartPos As Long
    Dim BetweenBrackets As Boolean
    
    For Index = 1 To Len(Text)
        If Mid(Text, Index, 1) = ">" Then
            BetweenBrackets = True
            StartPos = Index
        ElseIf Mid(Text, Index, 1) = "<" Then
            If BetweenBrackets Then
                OutText = OutText & Mid(Text, StartPos + 1, Index - StartPos - 1)
            End If
            BetweenBrackets = False
        End If
    Next
    GetTextBetweenBrackets = OutText
    
End Function


Sub Test()

    Dim Data As Range
    Dim Cell As Range
    
    Set Data = Range("G1:G4")
    For Each Cell In Data.Cells
        Cell.Offset(0, 1) = GetTextBetweenBrackets(Cell.Value)
    Next
    
End Sub

Andy - the Function is working fine.

Do you mind tweaking the code to remove all instances of   ?

Example:

Input: KW 18 8x21DCF  POWERVIEW Folding Series 383ft/1000yds 128m/1000m with case
Output: KW 18 8x21DCF POWERVIEW Folding Series 383ft/1000yds 128m/1000m with case

Note: there can be multiple instances of   in any given cell data.

**Andy Pope** · 08-04-2015, 06:43 AM

change the last line of the function

    GetTextBetweenBrackets = Replace(OutText, "&nbsp;", "")

**mave27** · 08-04-2015, 06:53 AM

Originally Posted by Andy Pope

change the last line of the function

    GetTextBetweenBrackets = Replace(OutText, "*", "")

Thanks.

I've noticed some other bits of Text that i don't want like &

What would be the modified code to incorporate any additional text to omit ?

**Andy Pope** · 08-04-2015, 06:56 AM

Function GetTextBetweenBrackets(Text As String, RemoveItems As Variant) As String

    Dim OutText As String
    Dim Index As Long
    Dim StartPos As Long
    Dim BetweenBrackets As Boolean
    Dim Item As Variant
    
    For Index = 1 To Len(Text)
        If Mid(Text, Index, 1) = ">" Then
            BetweenBrackets = True
            StartPos = Index
        ElseIf Mid(Text, Index, 1) = "<" Then
            If BetweenBrackets Then
                OutText = OutText & Mid(Text, StartPos + 1, Index - StartPos - 1)
            End If
            BetweenBrackets = False
        End If
    Next
    
    For Each Item In RemoveItems
        OutText = Replace(OutText, Item, "")
    Next
    
    GetTextBetweenBrackets = OutText
    
End Function


Sub Test()

    Dim Data As Range
    Dim Cell As Range
    
    Set Data = Range("G1:G5")
    For Each Cell In Data.Cells
        Cell.Offset(0, 1) = GetTextBetweenBrackets(Cell.Value, _
                                        Array("&nbsp;", "&amp;"))
    Next
    
End Sub

You can add items to the Array list

**mave27** · 08-04-2015, 07:10 AM

Originally Posted by Andy Pope

Function GetTextBetweenBrackets(Text As String, RemoveItems As Variant) As String

    Dim OutText As String
    Dim Index As Long
    Dim StartPos As Long
    Dim BetweenBrackets As Boolean
    Dim Item As Variant
    
    For Index = 1 To Len(Text)
        If Mid(Text, Index, 1) = ">" Then
            BetweenBrackets = True
            StartPos = Index
        ElseIf Mid(Text, Index, 1) = "<" Then
            If BetweenBrackets Then
                OutText = OutText & Mid(Text, StartPos + 1, Index - StartPos - 1)
            End If
            BetweenBrackets = False
        End If
    Next
    
    For Each Item In RemoveItems
        OutText = Replace(OutText, Item, "")
    Next
    
    GetTextBetweenBrackets = OutText
    
End Function


Sub Test()

    Dim Data As Range
    Dim Cell As Range
    
    Set Data = Range("G1:G5")
    For Each Cell In Data.Cells
        Cell.Offset(0, 1) = GetTextBetweenBrackets(Cell.Value, _
                                        Array("*", "&"))
    Next
    
End Sub

You can add items to the Array list

New code is giving an Error of #VALUE!

PS: i have changed code from

Set Data = Range("G1:G5")

to

Set Data = Range("G1:G2000")

to reflect the range on my worksheet

**Andy Pope** · 08-04-2015, 07:22 AM

returns the following, assuming all in a single cell

GATE VALVE LOCKOUT Virtually indestructible valve covers. Once locked, they rotate freely around the hand wheel prevent the valve wheel from being turned. The strong polyurethane plastics make them resistant to cracking and abrasion. They are resistant to extreme weather and temperature conditions. Available in5 sizes ( Red colour )Other colours are available on request - minimum quantity applicable. 3 padlock holes are available in each gate valve lockout device. Different sizes cover most commonly used valve diameters. Withstands temperatures from - 20°F to 200°F Unique knockout center accommodates OS Y or “rising stem” valves. Suitable for hasps and padlocks. Dimensions Size Inside dia (A) Inside depth.(B) Outside dia. (C) Outside height (D) 25 - 63.5 mm 70 mm 32 mm 76 mm 38 mm 63.5 - 127 mm 130 mm 34 mm 140 mm 44 mm 127 - 165 mm 170 mm 41 mm 177 mm 50 mm 165 - 254 mm 257 mm 50 mm 267 mm 63 mm 254 - 355 mm 355 mm 63 mm 368 mm 74 mm MODEL PRODUCT DESCRIPTION ES -02 - GVL Fits on handle wheel dia from 25 to 63.5 mm ( 1" - 2½" inch) ES -04 - GVL Fits on handle wheel dia from 63.5 to 127 mm ( 2½" - 5" inch) ES -06 - GVL Fits on handle wheel dia from 127 to 165 mm ( 5" - 6½" inch) ES -08 - GVL Fits on handle wheel dia from 165 to 254 mm ( 6½" - 10" inch) ES -10 - GVL Fits on handle wheel dia from 254 to 355 mm ( 10" - 13" inch)

Perhaps you should post a workbook example

**mave27** · 08-04-2015, 07:52 AM

Andy - prev version of code works fine, but the newer gives error of #VALUE!. (stangely

)

I'll just do a search & replace to remove unwanted Text from final output.

Thanks again.

**Andy Pope** · 08-04-2015, 07:16 AM

hard to say without seeing what the contexts of the cell are

The code works for the examples you have provided so far

**mave27** · 08-04-2015, 07:18 AM

Originally Posted by Andy Pope

hard to say without seeing what the contexts of the cell are

The code works for the examples you have provided so far

Do you mind running the latest modified code for Input Value:

<h2>GATE VALVE LOCKOUT                                                                                                                 </h2> <table border="0" cellspacing="0" cellpadding="0" width="755"> <tbody> <tr> <td width="490" valign="top"> <ul> <li>Virtually indestructible valve covers.</li> <li>Once locked, they rotate freely around the hand wheel & prevent the valve wheel from being turned.</li> <li>The strong polyurethane plastics make them resistant to cracking and abrasion.</li> <li>They are resistant to extreme weather and temperature conditions.</li> <li>Available in 5 sizes ( Red colour ) Other colours are available on request - minimum quantity applicable.</li> <li>3 padlock holes are available in each gate valve lockout device.</li> <li>Different sizes cover most commonly used valve diameters.</li> <li>Withstands temperatures from - 20°F to 200°F</li> <li>Unique knockout center accommodates OS & Y or “rising stem” valves.</li> <li>Suitable for hasps and padlocks.</li> </ul> <table border="0" cellspacing="0" cellpadding="0" width="435"> <tbody> <tr> <td class="tblHeaderLeft1" colspan="6">    Dimensions</td> </tr> <tr> <td class="tbBlack">Size</td> <td class="tbBlack">Inside dia (A)</td> <td class="tbBlack">Inside depth.(B)</td> <td class="tbBlack">Outside dia. (C)</td> <td class="tbBlack">Outside height (D)</td> </tr> <tr> <td class="tbWhite">25 - 63.5 mm</td> <td class="tbWhite">70 mm</td> <td class="tbWhite">32 mm</td> <td class="tbWhite">76 mm</td> <td class="tbWhite">38 mm</td> </tr> <tr> <td class="tbWhite">63.5 - 127 mm</td> <td class="tbWhite">130 mm</td> <td class="tbWhite">34 mm</td> <td class="tbWhite">140 mm</td> <td class="tbWhite">44 mm</td> </tr> <tr> <td class="tbWhite">127 - 165 mm</td> <td class="tbWhite">170 mm</td> <td class="tbWhite">41 mm</td> <td class="tbWhite">177 mm</td> <td class="tbWhite">50 mm</td> </tr> <tr> <td class="tbWhite">165 - 254 mm</td> <td class="tbWhite">257 mm</td> <td class="tbWhite">50 mm</td> <td class="tbWhite">267 mm</td> <td class="tbWhite">63 mm</td> </tr> <tr> <td class="tbWhite">254 - 355 mm</td> <td class="tbWhite">355 mm</td> <td class="tbWhite">63 mm</td> <td class="tbWhite">368 mm</td> <td class="tbWhite">74 mm</td> </tr> </tbody> </table> <table border="0" cellspacing="0" cellpadding="0"> <tbody> <tr> <td class="tblHeaderLeft">MODEL</td> <td class="tblHeaderRight">PRODUCT DESCRIPTION</td> </tr> <tr> <td class="tblHeaderLeftcode">ES - 02 - GVL</td> <td class="tblHeaderRightcode">Fits on handle wheel dia from 25 to 63.5 mm ( 1" - 2½" inch)</td> </tr> <tr> <td class="tblHeaderLeftcode">ES - 04 - GVL</td> <td class="tblHeaderRightcode">Fits on handle wheel dia from 63.5 to 127 mm ( 2½" - 5" inch)</td> </tr> <tr> <td class="tblHeaderLeftcode">ES - 06 - GVL</td> <td class="tblHeaderRightcode">Fits on handle wheel dia from 127 to 165 mm ( 5" - 6½" inch)</td> </tr> <tr> <td class="tblHeaderLeftcode">ES - 08 - GVL</td> <td class="tblHeaderRightcode">Fits on handle wheel dia from 165 to 254 mm ( 6½" - 10" inch)</td> </tr> <tr> <td class="tblHeaderLeftcode">ES - 10 - GVL</td> <td class="tblHeaderRightcode">Fits on handle wheel dia from 254 to 355 mm ( 10" - 13" inch)</td> </tr> </tbody> </table> </td> <td width="260" valign="top"><img src="http://www.safetylock.esquare.info/images/valve/valve1.jpg" alt="" width="250" align="right" /></td> </tr> </tbody> </table>

**JasperD** · 08-04-2015, 08:15 AM

Question, why are you going about it so difficult?
Wouldn't this just do the trick - assuming you put the source text into A1.

Sub ExcelForum()
Dim doc As New HTMLDocument, rws, x&
doc.body.innerHTML = ActiveSheet.Range("A1")
rws = Split(doc.body.innerText, Chr(10))

For x = LBound(rws) To UBound(rws)
ActiveSheet.Range("A2").Offset(x) = rws(x)
Next x

End Sub

Gives output split per line in range A2 downward.
Set reference to Microsoft HTML Object Library

Works fine on all your supplied examples.

**mave27** · 08-04-2015, 08:42 AM

Originally Posted by JasperD

Question, why are you going about it so difficult?
Wouldn't this just do the trick - assuming you put the source text into A1.

Sub ExcelForum()
Dim doc As New HTMLDocument, rws, x&
doc.body.innerHTML = ActiveSheet.Range("A1")
rws = Split(doc.body.innerText, Chr(10))

For x = LBound(rws) To UBound(rws)
ActiveSheet.Range("A2").Offset(x) = rws(x)
Next x

End Sub

Gives output split per line in range A2 downward.
Set reference to Microsoft HTML Object Library

Works fine on all your supplied examples.

Not sure what you mean by "reference to Microsoft HTML Object Library" .

Can you kindly elaborate on how use this code ? Where do i place it ? Under Modules (Alt + F11) ?

**JasperD** · 08-04-2015, 09:01 AM

Yes, under modules.
Then in the top bar, go to Tools, References and select Microsoft HTML Object Library

Then run the code, should work fine.

VBA Code to extract Text btwn ">TEXT<" ?

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

VBA Code to extract Text btwn ">TEXT<" ?

Re: VBA Code to extract Text btwn ">TEXT<" ?

Re: VBA Code to extract Text btwn ">TEXT<" ?

Re: VBA Code to extract Text btwn ">TEXT<" ?

Re: VBA Code to extract Text btwn ">TEXT<" ?

Re: VBA Code to extract Text btwn ">TEXT<" ?

Re: VBA Code to extract Text btwn ">TEXT<" ?

Re: VBA Code to extract Text btwn ">TEXT<" ?

Re: VBA Code to extract Text btwn ">TEXT<" ?

Re: VBA Code to extract Text btwn ">TEXT<" ?

Re: VBA Code to extract Text btwn ">TEXT<" ?

Re: VBA Code to extract Text btwn ">TEXT<" ?

Re: VBA Code to extract Text btwn ">TEXT<" ?

Re: VBA Code to extract Text btwn ">TEXT<" ?

Re: VBA Code to extract Text btwn ">TEXT<" ?

Re: VBA Code to extract Text btwn ">TEXT<" ?

Re: VBA Code to extract Text btwn ">TEXT<" ?

Re: VBA Code to extract Text btwn ">TEXT<" ?

Thread Information

Users Browsing this Thread

Similar Threads

create text string: "NOT "[b2value]", NOT "[b3value]", ..., NOT "[b600value]"

[SOLVED] Code that copies row of data to another sheet based on text "Complete"/"Delete"

NEED HELP! Code that copies row of data to another sheet based on text "Complete"/"Delete"

[SOLVED] EXTRACT TEXT "SHM" or "SHGB"

Trying to extract "Text" inbetween ":" and ","

Extract value from rows when top row text = "Admin" and "Clin", then calculate the mean

Read select "text" from "Text File" using VBA code

Bookmarks

Bookmarks

Posting Permissions