Excel extract bold Words in text

user_3522829 0
Viewed 6160

Can anyone assist me with my Excel Problem? I have a cell filled with text. Some words of this Text are printed bold. Those words are keywords and should be extraxted to another cell in the Row for identification of the keywords. Example:

Text in Cell:

I want to use Google Maps for route informations

Output:

Google; Maps; route;

Thank you in advance!

filter vba excel
2 Answers

You can also use this UDF to produce same result. Please enter below code in module. 

 Public Function findAllBold(ByVal rngText As Range) As String
    Dim theCell As Range
    Set theCell = rngText.Cells(1, 1)

    For i = 1 To Len(theCell.Value)       
        If theCell.Characters(i, 1).Font.Bold = True Then          
            If theCell.Characters(i + 1, 1).Text = " " Then
                theChar = theCell.Characters(i, 1).Text & ", "
                Else
                theChar = theCell.Characters(i, 1).Text
            End If
            Results = Results & theChar
        End If
   Next i
   findAllBold = Results
End Function

Now you can use newly created function to return bold values from any cell.

enter image description here

user_82596470

Try this

Option Explicit

Sub Demo()

    Dim ws As Worksheet
    Dim str As String, strBold As String
    Dim isBold As Boolean
    Dim cel As Range
    Dim lastRow As Long, i As Long

    Set ws = ThisWorkbook.Sheets("Sheet1")    'change Sheet1 to your data sheet
    isBold = False

    With ws
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row    'last row with data in Column A
        For Each cel In .Range("A1:A" & lastRow).Cells      'loop through each cell in Column A
            strBold = ""
            For i = 1 To Len(cel.Value)
                If cel.Characters(Start:=i, Length:=1).Font.Bold = True Then 'check if character is bold
                    isBold = True
                    str = Mid(cel.Value, i, 1)
                    If cel.Characters(Start:=i, Length:=1).Text = " " Then  'check for space
                        strBold = strBold & "; "
                        isBold = False
                    Else
                        strBold = strBold & str
                    End If

                Else
                    If isBold Then
                        strBold = strBold & "; "
                        isBold = False
                    End If
                End If
            Next
            cel.Offset(0, 1) = strBold
        Next
    End With
End Sub

enter image description here

Derived this code from here.

user_60752590
Related