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