Multi color text in single cell - vb macro

ebehen

New Member
Joined
Mar 26, 2008
Messages
1
I am using a macro and worksheet, found on the form and changing it to fit my needs, that takes a list of dates and creates a calender. There are multiple events on a single date (or Cell) I want to format the text of individual events to be color coded based on a value. Here is the code I am working with.

Code:
Private Sub ShowSpecialDates()
Dim I As Integer
Dim TestDate As Date
Dim TestCell As Range
Dim HRange As Range
Dim d As Integer
Dim addtext As String
Dim CellLen As Integer
Dim Newlen As Integer

Set HRange = Range(Range("HDateStart"), Range("HDateStart")(65000).End(xlUp)(1, 1))

For I = 1 To 42
    d = Val(Cal(I - 1))
    If d > 0 Then
        TestDate = DateSerial(CurrYear, CurrMonth, d)
        For Each TestCell In HRange
            If TestCell.Value = TestDate Then
                addtext = TestCell(1, 3).Value
                Newlen = Len(TestCell(1, 3))
                CellLen = Len(Cal(I - 1))
                Select Case TestCell(1, 2).Value
                    Case "H"
                        If Range("ShowHoliday").Value = True Then
                            Cal(I - 1) = Cal(I - 1) & Chr(10) & addtext
                             Range("CalRng")(I).Characters(CellLen, Newlen).Font.ColorIndex = 3
                            If Range("MultItems").Value = False Then
                                Exit For
                            End If
                        End If
                    Case "B"
                        If Range("ShowBirthday").Value = True Then
                            Cal(I - 1) = Cal(I - 1) & Chr(10) & addtext
                            Range("CalRng")(I).Characters(CellLen, Newlen).Font.ColorIndex = 4
                            If Range("MultItems").Value = False Then
                                Exit For
                            End If
                        End If
                    Case "O"
                        If Range("ShowHoliday").Value = True Then
                            Cal(I - 1) = Cal(I - 1) & Chr(10) & addtext
                            Range("CalRng")(I).Characters(CellLen, Newlen).Font.ColorIndex = 5
                            If Range("MultItems").Value = False Then
                                Exit For
                            End If
                        End If
                    Case Else
                End Select
            End If
        Next TestCell

    End If
Next I
End Sub

But this colors all the text in the cell based on the last event. Not sure where i went wrong. or if someone has a better way of doing this please let me know.

Thanks in advance.
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

pbornemeier

Well-known Member
Joined
May 24, 2005
Messages
3,884
Without seeing how you have your named ranges and data setup it is hard to understand exactly what your code is doing, but I think I have it.

What is the relationship between Cal(I-1) and Range("CalRng")(I) you are testing on the first one and setting colors on the second.

For immediate troubleshooting, I would add a debug.print statement after each of these:
Rich (BB code):
Range("CalRng")(I).Characters(CellLen, Newlen).Font.ColorIndex = x
Debug.Print TestCell(1, 2).Value, I, CellLen, Newlen
and step through the code to check to see if you are getting the values you expect.

You might also want to change these lines:
Rich (BB code):
Range("CalRng")(I).Characters(CellLen + 1, Newlen).Font.ColorIndex = x
so you are coloring from the start of the added text
 

Watch MrExcel Video

Forum statistics

Threads
1,122,709
Messages
5,597,693
Members
414,164
Latest member
ARTW

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top