Doghouse308
Doghouse308

Reputation: 619

Making and keeping part of a cell bold - Excel

I want a cell in my spreadsheet to make part of the cell bold. I found a similar post. It does work, to a degree. It works the first time the cell is updated, but if the cell is updated, everything becomes bold. I used the method described in the above link in the first two columns (cases 9 and 10 in the switch statement), but would do not want to update the other columns until I have something that works correctly

Private Sub Worksheet_Change(ByVal Target As Range)

Dim comment As String
Dim time As String
Dim StartCell As String
Dim EndCell As String
Dim pos As Integer
Dim newComment As String

If Target.Cells.CountLarge > 1 Then
   Exit Sub
End If

StartCell = "A" & Target.Row
EndCell = "W" & Target.Row
time = Target.Value
time = Format(Target.Value, "h:mm AM/PM")
comment = Range("S" & Target.Row).Value
If Not Intersect(Target, Range("I4:R254")) Is Nothing Then
    If Target.Value <> "" Then
        Select Case Target.Column
            Case 9
                newComment = time & " EST Tech on site, initial prep, SW and SO# verified"
                pos = InStr(newComment, "EST")

                If comment = "" Then
                     Range("S" & Target.Row) = time & " EST Tech on site, initial prep, SW and SO# verified"
                     Range("S" & Target.Row).Characters(Start:=1, Length:=pos - 1).Font.Bold = True
                Else
                    Range("S" & Target.Row) = time & " EST Tech on site, initial prep, SW and SO# verified" & Chr(10) & comment
                    Range("S" & Target.Row).Characters(Start:=1, Length:=pos - 1).Font.Bold = True
                End If

                Range("R" & Target.Row) = "In Progress"

            Case 10
                newComment = time & " EST Installing HW" & Chr(10) & comment
                pos = InStr(newComment, "EST")
                If Range("J" & Target.Row).Value < Range("I" & Target.Row).Value Then
                    MsgBox ("Time for Checkpoint 2 must be greater than Checkpoint 1")
                    Target.Value = ""
                    Target.Select
                Else
                    Range("S" & Target.Row) = time & " EST Installing HW" & Chr(10) & comment
                    Range("S" & Target.Row).Characters(Start:=1, Length:=pos - 1).Font.Bold = True
                End If

            Case 11
                If Range("K" & Target.Row).Value < Range("J" & Target.Row).Value Then
                    MsgBox ("Time for Checkpoint 3 must be greater than Checkpoint 2")
                    Target.Value = ""
                    Target.Select
                Else
                    Range("S" & Target.Row) = time & " EST Phase 1 SW Installation" & Chr(10) & comment
                End If
            Case 12
               If Range("L" & Target.Row).Value < Range("K" & Target.Row).Value Then
                    MsgBox ("Time for Checkpoint 4 must be greater than Checkpoint 3")
                    Target.Value = ""
                    Target.Select
                Else
                    Range("S" & Target.Row) = time & " EST Running TPM and checking devices" & Chr(10) & comment
                End If
            Case 13
                If Range("M" & Target.Row).Value < Range("L" & Target.Row).Value Then
                    MsgBox ("Time for Checkpoint 5 must be greater than Checkpoint 4")
                    Target.Value = ""
                    Target.Select
                Else
                    Range("S" & Target.Row) = time & " EST Phase 2 SW Installation" & Chr(10) & comment
                End If
            Case 14
                If Range("N" & Target.Row).Value < Range("M" & Target.Row).Value Then
                    MsgBox ("Time for Checkpoint 6 must be greater than Checkpoint 5")
                    Target.Value = ""
                    Target.Select
                Else
                    Range("S" & Target.Row) = time & " EST Post Imaging Tasks" & Chr(10) & comment
                End If
            Case 15
                If Range("O" & Target.Row).Value < Range("N" & Target.Row).Value Then
                    MsgBox ("Time for Checkpoint 7 must be greater than Checkpoint 6")
                    Target.Value = ""
                    Target.Select
                Else
                    Range("S" & Target.Row) = time & " EST Upgrade Complete" & Chr(10) & comment
                    Range("R" & Target.Row) = "Complete"
                End If

            Case 18
                Select Case Target.Value
                    Case ""
                        Range(StartCell, EndCell).Interior.ColorIndex = 0
                        Range(StartCell, EndCell).Font.ColorIndex = 1
                    Case "Pending"
                        Range(StartCell, EndCell).Interior.ColorIndex = 0
                        Range(StartCell, EndCell).Font.ColorIndex = 1
                    Case "En Route"
                        Range(StartCell, EndCell).Interior.ColorIndex = 15
                        Range(StartCell, EndCell).Font.ColorIndex = 1
                    Case "In Progress"
                        Range(StartCell, EndCell).Interior.ColorIndex = 36
                        Range(StartCell, EndCell).Font.ColorIndex = 1
                    Case "Complete"
                        Range(StartCell, EndCell).Interior.Color = RGB(84, 130, 53)
                        Range(StartCell, EndCell).Font.Color = RGB(255, 255, 204)
                    Case "Cancelled"
                        Range(StartCell, EndCell).Font.ColorIndex = 3
                    Case "Rescheduled"
                        Range(StartCell, EndCell).Interior.ColorIndex = 0
                        Range(StartCell, EndCell).Font.ColorIndex = 3
                    Case "Carryover"
                        Range(StartCell, EndCell).Interior.Color = RGB(0, 153, 255)
                        Range(StartCell, EndCell).Font.ColorIndex = 3

                  End Select
            End Select
        End If
    End If
End Sub

Upvotes: 1

Views: 205

Answers (1)

Dick Kusleika
Dick Kusleika

Reputation: 33145

If there's anyway you can avoid formatting characters individually, you should. You'll spend a lot of time on it and just when you think you've got it, someone will figure a way to break it. Like if you just put the time in it's own cell, you'd be a lot happier. Having said that, this gets you close and you may be able to tweak it from there.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rLog As Range
    Dim sInput As String
    Dim aMsg(1 To 7) As String
    Dim i As Long
    Dim sTime As String
    Dim lBoldEnd As Long

    Const TIMESAVE As String = "EDT"

    If Target.Cells.CountLarge > 1 Then
       Exit Sub
    End If

    aMsg(1) = "Tech on site, initial prep, SW and SO# verified"
    aMsg(2) = "Installing HW"
    aMsg(3) = "Phase 1 SW Installation"
    aMsg(4) = "Running TPM and checking devices"
    aMsg(5) = "Phase 2 SW Installation"
    aMsg(6) = "Post Imaging Tasks"
    aMsg(7) = "Upgrade Complete"

    If Not Intersect(Target, Me.Range("I4:O254")) Is Nothing Then
        If Not IsEmpty(Target.Value) Then
            If Target.Column > 9 And Target.Value < Target.Offset(0, -1).Value Then
                MsgBox "Time for checkpoint " & Target.Column - 8 & " must be less than time for checkpoint " & Target.Column - 7
                Application.EnableEvents = False
                    Target.ClearContents
                Application.EnableEvents = True
            Else
                Set rLog = Me.Cells(Target.Row, 19) 's
                sTime = Format(Target.Value, "hh:mm AM/PM """ & TIMESAVE & """")
                Application.EnableEvents = False
                    rLog.Font.Bold = False
                    If IsEmpty(rLog.Value) Then
                        rLog.Value = sTime & Space(1) & aMsg(Target.Column - 8)
                    Else
                        rLog.Value = sTime & Space(1) & aMsg(Target.Column - 8) & Chr$(10) & rLog.Value
                    End If
                    rLog.Characters(1, Len(sTime)).Font.Bold = True
                    For i = Len(sTime) To Len(rLog.Value)
                        If Mid$(rLog.Value, i, 1) = Chr$(10) Then
                            lBoldEnd = InStr(1, Mid$(rLog.Value, i + 1, Len(rLog.Value)), TIMESAVE) + Len(TIMESAVE)
                            If lBoldEnd > 0 Then
                                rLog.Characters(i + 1, lBoldEnd).Font.Bold = True
                            End If
                        End If
                    Next i
                    rLog.WrapText = True
                Application.EnableEvents = True
            End If
        End If
    End If

End Sub

For your column 18 stuff, you should just use Conditional Formatting rather than doing it in the code. Also, it's daylight time, if that matters to you.

Upvotes: 3

Related Questions