How to Bold 2nd line in a cell with VBA



I need to have every second line in a cell in bold. Can you help me with the code? I have found codes on the internet but all of them bolds the first line only. I'm not sure how to change them. 

Sample: ( I need the Show me a sign in Bold along with every 2nd line in every cell)

October 01, 2017
Show me a sign
You ask the Universe to show you a sign that you should leave your job... and the next thing you know you're driving down Leave-Your-Job Blvd, and you're like, 'I wonder if that was a sign.' - Kyle Cease
The thought that we need a sign to take action is the sign we're looking for. After all, when something is truly relevant for us, it feels right, and we certainly don't go around obsessing over whether or not we should change it. 

Option Explicit
Sub BoldFirstLine()
    Dim r As Range, c As Range
    Dim ws As Worksheet
Set ws = ActiveSheet
Set r = ws.UsedRange
For Each c In r
    With c
        .Font.Bold = False
        .Value = .Text
        .Characters(1, InStr(.Text, vbLf) - 1).Font.Bold = True
    End With
Next c
End Sub

Thank you in advance!




This should do the job.

Option Explicit
Sub BoldSecondLine()
    ' 30 Oct 2017
    Dim Ws As Worksheet
    Dim Cell As Range
    Application.ScreenUpdating = False
    Set Ws = ActiveSheet
    For Each Cell In Ws.UsedRange
        MakeSecondLineBold Cell
    Next Cell
    Application.ScreenUpdating = True
End Sub
Sub MakeSecondLineBold(Cell As Range)
    ' 30 Oct 2017
    Dim Bstart As Integer, Bcount As Integer
    Dim Tmp As String
    With Cell
        Bstart = InStr(.Value, Chr(10)) + 1
        If (Bstart > 1) And Len(.Value) > (Bstart) Then
            Bcount = InStr(Mid(.Value, Bstart), Chr(10)) - 1
            If Bcount < 0 Then Bcount = Len(Mid(.Value, Bstart))
            .Font.Bold = False
            .Characters(Bstart, Bcount).Font.Bold = True
        End If
    End With
End Sub

Answer the Question

You must create an account to use the forum. Create an Account or Login