Reputation: 619
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
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