VBA to Underline only portions of text in single cell

[jfarc]

Is there anything that I can do in VBA to apply an Underline start & Underline stop command to only a portion of a text string?

Example Code:

Range("A1").Value = "The quick brown " & Start Underline & "fox jumps over" & Stop Underline & " the lazy dog."

So the end result in cell 'A1' would be the text "The quick brown fox jumps over the lazy dog."

(Apparently it's easy to do using BB Code in this post)

 

[Scott Huish]

Sub test()
Range("A1") = "The quick brown fox jumps over the lazy dog."
Range("A1").Characters(17, 13).Font.Underline = True
End Sub

 

[mwrohr]

Very cool, Scott - never seen that before!

 

[jfarc]

Sub test()
Range("A1") = "The quick brown fox jumps over the lazy dog."
Range("A1").Characters(17, 13).Font.Underline = True
End Sub

Yes, that is interesting. Although, it makes me take a step back and re-look at my original problem that I had resolved in post link - http://www.mrexcel.com/forum/excel-...n-matching-widcard-then-some.html#post3523928 , which then led me to this Underlining issue. So, maybe there is a different path I need to take all together. Because I'm not sure how to apply your resolution to my actual problem.

From the Pattern Matching post, this is my original raw sample data that resides in a single cell:

   *** 09:23:20  18 JUL 2013 bobj JC-FI BOB_JETER ***   THIS IS THE 4TH COMMENT. I AM TYPING IN AT LINE7 ON THE 'M' SCREEN   *** 09:20:53  18 JUL 2013 davidf JC-FI DAVE_FRANKLIN ***   THIS IS THE 3RD COMMENT ENTERED.   *** 09:19:03  18 JUL 2013 deang JC-FI DEAN_GIFFORD ***   THIS IS THE 2ND COMMENT.   *** 09:16:20  18 JUL 2013 dealerp JC-FI DEALERPAIR ***   USING THIS DEAL TO TEST THE COMMENTS SECTION.

My end of job (previously unstated) goal, is to reformat this messy data into the following format still in it's single cell:

   ~ 09:23:20  18 JUL 2013 bobj JC-FI BOB_JETER ~
THIS IS THE 4TH COMMENT. I AM TYPING IN AT LINE7 ON THE 'M' SCREEN
   ~ 09:20:53  18 JUL 2013 davidf JC-FI DAVE_FRANKLIN ~
THIS IS THE 3RD COMMENT ENTERED.
   ~ 09:19:03  18 JUL 2013 deang JC-FI DEAN_GIFFORD ~
THIS IS THE 2ND COMMENT.
   ~ 09:16:20  18 JUL 2013 dealerp JC-FI DEALERPAIR ~
USING THIS DEAL TO TEST THE COMMENTS SECTION.

I can accomplish everything (except the Underlining) by applying the following 2 lines of code (& formatting the cell to Wrap):

    Selection.Replace What:="   ~*~*~* ", Replacement:=Chr(10), LookAt:=xlPart
    Selection.Replace What:="~*~*~*   ", Replacement:=Chr(10), LookAt:=xlPart

Because each of the original (3spaces3asterisks) and (3asterisks3spaces) delimiters are variable in number & length to each cell, I don't know how to apply your code.

If there was only a start & stop Underline CHR() function, I would be golden by adding it to the above Replace() function.

 

[mirabeau]

after your replace, include

Dim s As String
s = "09:23:20  18 JUL 2013 bobj JC-FI BOB_JETER"
Cells(1).Characters(InStr(Cells(1), s), Len(s)).Font.Underline = True

s is whatever string you want underlined in cell(1), or Range("A1").

 

[jfarc]

after your replace, include

Dim s As String
s = "09:23:20  18 JUL 2013 bobj JC-FI BOB_JETER"
Cells(1).Characters(InStr(Cells(1), s), Len(s)).Font.Underline = True

s is whatever string you want underlined in cell(1), or Range("A1").

Ok, let's say I change the Replace() to the following so I could then identify where from within the entire string the beginning |a| and the ending |b| of the Underlining should take place:

Selection.Replace What:="   ~*~*~* ", Replacement:=Chr(10) & "   |a| ", LookAt:=xlPart
Selection.Replace What:="~*~*~*   ", Replacement:="   |b| " &Chr(10), LookAt:=xlPart

I'm still a bit confused because there can be multiple occurrences of these identifiers in a single cell. After the Underlining is complete, I would then Replace() the |a| & |b| identifiers with what I want, the tilde ~.

 

[jfarc]

(to continue with last post)

So, the after the first Replace() and before the Underlining code, the data would be as follows:

   |a| 09:23:20  18 JUL 2013 bobj JC-FI BOB_JETER |b|
THIS IS THE 4TH COMMENT. I AM TYPING IN AT LINE7 ON THE 'M' SCREEN
   |a| 09:20:53  18 JUL 2013 davidf JC-FI DAVE_FRANKLIN |b|
THIS IS THE 3RD COMMENT ENTERED.
   |a| 09:19:03  18 JUL 2013 deang JC-FI DEAN_GIFFORD |b|
THIS IS THE 2ND COMMENT.
   |a| 09:16:20  18 JUL 2013 dealerp JC-FI DEALERPAIR |b|
USING THIS DEAL TO TEST THE COMMENTS SECTION.

 

[mirabeau]

if you want to underline several occurrences of a particular string within a cell you can try this. the example string in the code is "QQ" but you can use whatever you like.

Sub uline()
Const s As String = "QQ"
Dim x As Byte
Do
    x = InStr(x + 1, Cells(1), s)
    If x = 0 Then Exit Do
    Cells(1).Characters(x, Len(s)).Font.Underline = True
Loop
End Sub

 

[jfarc]

Ok, thanks Scott & mirabeau for getting me going on this. Using your suggestions I came up with a final solution that handles all the requirements. Since everything was variable, I had to get the code to figure out where everything started & stopped within the data in each cell.

Sub uline()

Dim s As String
Dim a As Integer
Dim b As Integer
Dim e As Integer
    
    Range("M" & ActiveCell.SpecialCells(xlLastCell).Row).Select
    For a = ActiveCell.Row To 1 Step -1
        Range("M" & a).Select
        s = ""
        b = 1
        e = 1
        Do
            b = InStr(b, ActiveCell, " ~ ")
            If b = 0 Then Exit Do
            e = b + 1
            e = InStr(e, ActiveCell, " ~   ")
            If e = 0 Then
                s = Mid(ActiveCell, b + 3, Len(ActiveCell) - b + 2)
                e = b + 1
            Else
                s = Mid(ActiveCell, b + 3, e - b - 4)
            End If
            ActiveCell.Characters(b + 3, Len(s)).Font.Underline = True
            b = e + 1
        Loop
    Next a
End Sub

 

[Scott Huish]

I haven't looked through the rest of your code, but it it is not necessary to Select, you can work with ranges directly in VBA.
Dim another variable as string, say u
Dim u as String
Change this line:
Range("M" & a).Select
to
u=Range("M" & a)

Everywhere except the Characters line, change Activecell to u

On the Characters line, change Activecell.Characters to Range("M" & a).Characters