Extracting underlined text

Maybe a UDF
Remark: extracts the underlined text, but the results are not underlined. Is it ok?

Function Underline(r As Range) As String
    Dim i As Long
    
    For i = 1 To Len(r.Value)
        With r
            If .Characters(Start:=i, Length:=1).Font.Underline <> xlUnderlineStyleNone Then
                Underline = Underline & .Characters(i, 1).Caption
            Else
                If Mid(r, i, 1) = Chr(32) Then Underline = Underline & Mid(r, i, 1)
            End If
        End With
    Next i
    
    Underline = Application.Trim(Underline)
End Function

Usage
B1
=Underline(A1)
copy down

A B

Some text and more underlined text	text underlined text
Text not underlined
Some Text	Some Text
More New Text underlined	New Text

Maybe a looping macro that checks every nth character's Underline property and returns them as a string?

Yes your idea is perfect.

Originally Posted by daffodil11

I think I had the right idea and it looks like it works!

Thanks Marcelo!

You are welcome.