Extract Bold Word from String

danbrown

New Member
Joined
Feb 2, 2017
Messages
42
Hi Guys
I need a simple code to extract a bolded word from a string in a cell.It then places this text in column b and the entire string in column C.Then it moves to next cell in range.
Eg:

Column A
extract THIS
skip thisand this
HERE
is done

Should like this:
Columnn B Column C
THIS extract THIS
HERE HERE is done

To prove im not one of those 'script-kiddies' ive added my code.
Since im not familiar with split function,I use characters ppt instead.

Code:
Dim rng as Range,counter as integer
Set rng = Range("a1:a4")
counter = 0
For each cell in rng
    For i = 1 to len(cell.text)
        If cell.font.character(i,1).bold = True Then
        Cells(counter + 1,2).value = [U][I]'Extracted word/chars'[/I][/U]
        Cells(counter + 1,3).value = Cell.value 
        End If
    Next i
counter = counter + 1
Next cell

Thanks in advance!
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

pgc01

MrExcel MVP
Joined
Apr 25, 2006
Messages
19,885
Hi
Welcome to the board

This is a solution to get you started:

Code:
Sub ExtractBold()
Dim r As Range, rC As Range
Dim lCounter As Long, i As Long
Dim sExtract As String
Dim bHasBold As Boolean

Set r = Range("A1:A4")

For Each rC In r
    sExtract = ""
    bHasBold = False
    ' if the cell has a bold word extract it to a string variable
    For i = 1 To Len(rC.Value)
        If rC.Characters(i, 1).Font.Bold Then
            bHasBold = True
            sExtract = sExtract & Mid(rC.Value, i, 1)
        End If
    Next i
    ' if a bold word was found in the cell copy it as well as the whole cell to columns B and C
    If bHasBold Then
        lCounter = lCounter + 1
        Range("B" & lCounter).Value = sExtract
        rC.Copy Destination:=Range("C" & lCounter)
    End If
Next rC

End Sub
 

danbrown

New Member
Joined
Feb 2, 2017
Messages
42
Hi
Welcome to the board

This is a solution to get you started:

Code:
Sub ExtractBold()
Dim r As Range, rC As Range
Dim lCounter As Long, i As Long
Dim sExtract As String
Dim bHasBold As Boolean

Set r = Range("A1:A4")

For Each rC In r
    sExtract = ""
    bHasBold = False
    ' if the cell has a bold word extract it to a string variable
    For i = 1 To Len(rC.Value)
        If rC.Characters(i, 1).Font.Bold Then
            bHasBold = True
            sExtract = sExtract & Mid(rC.Value, i, 1)
        End If
    Next i
    ' if a bold word was found in the cell copy it as well as the whole cell to columns B and C
    If bHasBold Then
        lCounter = lCounter + 1
        Range("B" & lCounter).Value = sExtract
        rC.Copy Destination:=Range("C" & lCounter)
    End If
Next rC

End Sub

Works like a charm!Thank u so much
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,151,836
Messages
5,766,716
Members
425,373
Latest member
ndiejennrrd

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top