Formatting Characters within a string

[CMIIandExcel]

Hi All

Is it possible to format a character in a string using vba?

For example if i had a string of GGGFF, and i wanted to make the G's appear as Green font and the F's as Red font.

Regards

Mike

 

[Richard Schollar]

Hi

Assuming these are hardcoded values and not the result of a formula then you can use the cell's character property:

With ActiveCell
    .Characters(1, 3).Font.ColorIndex = 4
    .Characters(4, 2).Font.ColorIndex = 3
End With

Look it up in VBA Help - it's straightforward as long as you know where the start/stop positions are.

 

[CMIIandExcel]

Richard

Thanks for the speedy Response.

The cell values i am working with are a result of a formula, How will this change the approach?

Regards

Mike

 

[CMIIandExcel]

Richard

To give some context the code below is where i am so far. ( i havent tested the code and wrote it on the fly so i am not sure yet on the logic)

I am trying to impliment the check of the characters and the change from a worksheet change event.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rngGraph As Range
Dim c As Range
Dim bits As Variant
Dim i As Long
Dim strStaringValue As String
Dim strFinalValue As String
rngGraph = Worksheets("Sheet1").Range("f3:f12")

If Target = rngGraph Then
  For Each c In rngGraph
    strFinalValue = ""
    strStaringValue = c.Value
    For i = 1 To Len(strStaringValue)
      If Mid(strStaringValue, i, 1).Value = "g" Then
        'Make Green
        strFinalValue = strFinalValue & Mid(strStaringValue, i, 1).Value
      Else
        'Make Red
        strFinalValue = strFinalValue & Mid(strStaringValue, i, 1).Value
      End If
      
    Next i
  Next c
End If

End Sub

Regards

Mike

 

[Richard Schollar]

Mike

If the string is the result of a formula (ie the cell where you want the formatting to occur is itself a formula cell) then you can't format the string (in the way you want). You can only do this with hardcoded values I'm afraid.

 

[CMIIandExcel]

Richard

Could i mirror the values returned by the formula, rewrite this mirror when the formula result changes (within the worksheet change event), and then affect the formatting against this mirror?

Hope you follow my logic

Regards Mike

 

[Richard Schollar]

Yes, but worksheet change won't be of use I'm afraid - it won't detect formula changes. For that you need to hook in to the Worksheet_Calculate event. Doing this you can check the value of the specified cell and if changed (eg compare to the hardcoded cell), copy across to your hardcoded cell and effect the format changes.

Note that the worksheet_calculate can impose a significant overhead on the workbook so it should be used sparingly.

 

[CMIIandExcel]

Richard

I have set my change event to look at the data which is used in the formula, by defult when the data changes the results of the formula will also change.

This is where my code is at the moment

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rngGraph As Range
Dim c As Range
Dim i As Long
Dim strValue As String

Dim rngData As Range
Dim iRow As Long
Dim wsSh As Worksheet
Set wsSh = Worksheets("Sheet1")
Set rngData = wsSh.Range("a3:a12")
Set rngGraph = wsSh.Range("f3:f12")
iRow = 3


If Not Intersect(Target, rngData) Is Nothing Then
  For Each c In rngGraph
    strValue = c.Value
    wsSh.Cells(iRow, 18).Value = strValue
    wsSh.Cells(iRow, 18).Activate
    With ActiveCell
      For i = 1 To Len(strValue)
        If Mid(strValue, i, 1).Value = "g" Then
          .Characters(i, 1).Font.ColorIndex = 4
        Else
          .Characters(i, 1).Font.ColorIndex = 3
        End If
      Next i
    End With
    iRow = iRow + 1
  Next c
End If

End Sub

One flaw is that the code changes the worksheet and seems to fire the change event off again. Is the a way to turn the change event off while working through the code, then turn it back on at the end ?


Please let me know if i am flogging a dead horse and i will stop, but i would like to solve this problem

Regards

Mike

 

[CMIIandExcel]

Re: Formatting Characters within a string - Working but Slow

The code below works, but is fairly slow in its running. This in itself is not an issue as the data doesnt change much, however any thoughts on how the code could be improved would be welcome.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rngGraph As Range
Dim c As Range
Dim i As Long
Dim strValue As String
Dim strFinalValue As String
Dim strChar As String
Dim rngData As Range
Dim iRow As Long
Dim wsSh As Worksheet
Set wsSh = Worksheets("Sheet1")
Set rngData = wsSh.Range("a3:a12")
Set rngGraph = wsSh.Range("f3:f12")
iRow = 3

Application.EnableEvents = False
If Not Intersect(Target, rngData) Is Nothing Then
  For Each c In rngGraph
    strValue = c.Value
    wsSh.Cells(iRow, 18).Value = strValue
    wsSh.Cells(iRow, 18).Activate
    With ActiveCell
      For i = 1 To Len(strValue)
        If Mid(strValue, i, 1) = "g" Then
          .Characters(i, 1).Font.ColorIndex = 4
        Else
          .Characters(i, 1).Font.ColorIndex = 3
        End If
      Next i
    End With
    iRow = iRow + 1
  Next c
End If
Application.EnableEvents = True
End Sub

Regards

Mike

 

[Richard Schollar]

Re: Formatting Characters within a string - Working but Slow

Well, there's no need to activaet the cells (not sure how much efficiency this will bring though) and you could probably improve the loop:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rngGraph As Range
Dim c As Range
Dim i As Long
Dim strValue As String
Dim strFinalValue As String
Dim strChar As String
Dim rngData As Range
Dim lngFirstG As Long
Dim wsSh As Worksheet
Set wsSh = Worksheets("Sheet1")
Set rngData = wsSh.Range("a3:a12")
Set rngGraph = wsSh.Range("f3:f12")
'iRow = 3
If Not Intersect(Target, rngData) Is Nothing Then
  Application.EnableEvents = False
  For Each c In Intersect(Target, rngData)
    c.Offset(, 18).Value = c.Offset(, 5).Value
    If Len(c.Offset(, 18).Value) > 0 Then
      c.Offset(, 18).Font.ColorIndex = 3
      lngFirstG = InStr(1, c.Offset(, 18).Value, "g", vbBinaryCompare)
      If lngFirstG > 0 Then
        Do
           c.Offset(, 18).Characters(lngFirstG, 1).Font.ColorIndex = 4
           lngFirstG = InStr(lngFirstG + 1, c.Offset(, 18).Value & " ", "g", vbBinaryCompare)
         Loop While lngFirstG > 0
      End If
    End If
  Next c
  Application.EnableEvents = True
End If
End Sub

I may have got the range references wrong so it would be a good idea to test this on a copy of your worksheet.