Changing Brackets to Underline

[cmcneal]

Hello,

With the project I'm working on, I pull data from one document to put into Excel. The original document doesn't use underlines, but rather vertical bars as a kind of bracket. Then when I paste in Excel, I have to manually take those bars out and underline. For example, I want to paste "|Book Title|" and have it show up as "Book Title". Any help would be appreciated!

[#2]

@cmcneal 

Here is a macro you can run afterwards, to change them in one go:

Sub Pipe2Underline()
    Dim rng As Range
    Application.ScreenUpdating = False
    With Cells
        Set rng = .Find(What:="|*|", LookAt:=xlWhole)
        If Not rng Is Nothing Then
            Do
                rng.Value = Replace(rng.Value, "|", "")
                rng.Font.Underline = xlUnderlineStyleSingle
                Set rng = .FindNext(After:=rng)
            Loop Until rng Is Nothing
        End If
    End With
    Application.ScreenUpdating = True
End Sub

[#3]

ko

[#4]

ko

[#5]

@Hans Vogelaar 

Actually, my mistake. It's working if the |book title| is the only thing in the cell, but it's not working if there is other text. I should have explained that before. So if it's only "|book title|", it works. But if it's "this is the |book title|" it doesn't

[#6]

@cmcneal 

Change the line

        Set rng = .Find(What:="|*|", LookAt:=xlWhole)

to

        Set rng = .Find(What:="|", LookAt:=xlPart)

[#7]

Sorry to ask for more help, but with that line changed, now it's underlining all the text in the cell, instead of only what was between the brackets

[#8]

@cmcneal 

Sorry, I didn't think that through.

Sub Pipe2Underline()
    Dim rng As Range
    Dim p1 As Long
    Dim p2 As Long
    Application.ScreenUpdating = False
    With Cells
        Set rng = .Find(What:="*|*|*", LookAt:=xlWhole)
        If Not rng Is Nothing Then
            Do
                p1 = InStr(1, rng.Value, "|")
                p2 = InStr(p1 + 1, rng.Value, "|")
                rng.Characters(p1 + 1, p2 - p1 - 1).Font.Underline = xlUnderlineStyleSingle
                rng.Characters(p1, 1).Text = ""
                rng.Characters(p2, 1).Text = ""
                Set rng = .FindNext(After:=rng)
            Loop Until rng Is Nothing
        End If
    End With
    Application.ScreenUpdating = True
End Sub