how to change font color based on filled color on another tab?

[hamsup1o]

Hi,
I am having a bit of trouble trying to figure out how to change the font color for certain letters in a cell based on the filled color from another tab.

This spreadsheet is an employee tracking schedule. Each employee has his/her own tab where they fill out their schedule. The format of the calendar is dates going across and months going down. The employee would put "v" for vacation, "w" for work from home, etc. There is a "group" tab where there is VBA script that consolidates all the employee tab by taking their first and last initials. The current script is consolidating all the tabs correctly however I would like to color code the initials based on the input. I have set conditional formatting for each of the cells on the individual employee tabs and would like to have the color coding on the "group" tab based on the filled color from the conditional formatting.

When the employee enters "v", the filled color for that cell turns red. I would like their initials for that date in the "group" tab to be red. If they enter "w", the filled color turns green and their initials will be green in the "group" tab.

For example:
John Smith is on vacation March 31st
Mary Williams is working from home on March 31st
On that date in the "group" tab, "JS MW" appears on the March 31st cell.

Hope this makes sense. I have attached the coding below. Any help would be greatly appreciated!


Here is the current code:

Function updatecounts()
'*This function recalculates the number of vacation days that each person
'*has taken or plans on taking.
 
Dim CurrCell As Range
 
Dim RepCell As Range
Dim x As Integer
Dim iNumPeople As Integer
Dim sInits() As String
Dim iLoopCount As Integer
Dim sCellNum As String
MousePointer = 11
 
Call readsheets
Me.Activate
'*Loop through getting initials
iNumPeople = Me.Range("Q25")
ReDim Count(iNumPeople, 2) As Integer
ReDim sInits(iNumPeople) As String
Do While iLoopCount < iNumPeople
    sCellNum = "Q" & 27 + iLoopCount
    sInits(iLoopCount) = Me.Range(sCellNum)
    iLoopCount = iLoopCount + 1
Loop
 
iLoopCount = 0
Do While iLoopCount < iNumPeople
 
    For Each CurrCell In Me.Range("B7:AF18")
 
 
        If InStr(CurrCell.Value, sInits(iLoopCount)) > 0 Then
            If CurrCell.Font.Bold = True Then
                Count(iLoopCount, 1) = Count(iLoopCount, 1) + 1
            Else
                Count(iLoopCount, 2) = Count(iLoopCount, 2) + 1
            End If
        End If
        'End If
    Next CurrCell
    iLoopCount = iLoopCount + 1
Loop
 
iLoopCount = 0
Do While iLoopCount < iNumPeople
    sCellNum = "R" & 27 + iLoopCount
    Me.Range(sCellNum).Value = Count(iLoopCount, 1)
    sCellNum = "S" & 27 + iLoopCount
    Me.Range(sCellNum).Value = Count(iLoopCount, 2)
    iLoopCount = iLoopCount + 1
Loop
 
'*Check for too many days taken
For Each CurrCell In Me.Range("T27:T" & 27 + (iNumPeople - 1))
    If CurrCell.Value > CurrCell.Offset(0, 1).Value Then
        CurrCell.Font.Color = 255
        CurrCell.Offset(0, -4).Font.Color = 255
        CurrCell.Font.Bold = True
        CurrCell.Offset(0, -4).Font.Bold = True
    Else
        CurrCell.Font.Color = 0
        CurrCell.Offset(0, -4).Font.Color = 0
        CurrCell.Font.Bold = False
        CurrCell.Offset(0, -4).Font.Bold = False
    End If
Next CurrCell
MousePointer = vbDefault
 
End Function
 
Function readsheets()
'*Loop through getting initials
iNumPeople = ThisWorkbook.Sheets.Count
Dim sInits As String
Dim iPeopleCount As Integer
ReDim sSumm(iNumPeople, 5) As String
 
ThisWorkbook.Sheets("group time").Range("vacasched").ClearContents
iLoopCount = 1
 
Do While iLoopCount < iNumPeople
    If ThisWorkbook.Worksheets(iLoopCount).Name <> "group time" Then
        ThisWorkbook.Worksheets(iLoopCount).Activate
        sInits = UCase(Left(ActiveSheet.Range("B4").Value, 1) & Left(ActiveSheet.Range("B3").Value, 1))
        sSumm(iLoopCount, 1) = Trim(ActiveSheet.Range("B4").Value) & " " & Trim(ActiveSheet.Range("B3").Value) 'Full Name
        sSumm(iLoopCount, 2) = sInits 'Initials
        sSumm(iLoopCount, 3) = 0 'taken
        sSumm(iLoopCount, 4) = 0 'planned
        sSumm(iLoopCount, 5) = ActiveSheet.Range("AF3").Value + ActiveSheet.Range("AF4").Value ' allowed days
 
        For Each CurrCell In ActiveSheet.Range("B7:AF18")
 
 
            If InStr("V", UCase(CurrCell.Value)) And Not IsEmpty(CurrCell.Value) Then
                ThisWorkbook.Sheets("group time").Cells(CurrCell.Row, CurrCell.Column).Value = ThisWorkbook.Sheets("group time").Cells(CurrCell.Row, CurrCell.Column).Value & " " & sInits
                If CurrCell.Font.Bold = True Then
                    ThisWorkbook.Sheets("group time").Cells(CurrCell.Row, CurrCell.Column).Font.Bold = True
                    sSumm(iLoopCount, 3) = sSumm(iLoopCount, 3) + 1
                Else
                    ThisWorkbook.Sheets("group time").Cells(CurrCell.Row, CurrCell.Column).Font.Bold = False
                    sSumm(iLoopCount, 4) = sSumm(iLoopCount, 4) + 1
                End If
            End If
        Next CurrCell
 
    End If
    iLoopCount = iLoopCount + 1
Loop
 
iLoopCount = 1
iPeopleCount = 0
Do While iLoopCount < iNumPeople
    If Not sSumm(iLoopCount, 1) = " " Then
        ThisWorkbook.Sheets("group time").Range("O" & Trim(Str(26 + iLoopCount))).Value = sSumm(iLoopCount, 1)
        ThisWorkbook.Sheets("group time").Range("Q" & Trim(Str(26 + iLoopCount))).Value = sSumm(iLoopCount, 2)
        ThisWorkbook.Sheets("group time").Range("R" & Trim(Str(26 + iLoopCount))).Value = sSumm(iLoopCount, 3)
        ThisWorkbook.Sheets("group time").Range("S" & Trim(Str(26 + iLoopCount))).Value = sSumm(iLoopCount, 4)
        ThisWorkbook.Sheets("group time").Range("T" & Trim(Str(26 + iLoopCount))).Value = "=R" & Trim(Str(26 + iLoopCount)) & " + S" & Trim(Str(26 + iLoopCount))
        ThisWorkbook.Sheets("group time").Range("U" & Trim(Str(26 + iLoopCount))).Value = sSumm(iLoopCount, 5)
        ThisWorkbook.Sheets("group time").Range("V" & Trim(Str(26 + iLoopCount))).Value = "=U" & Trim(Str(26 + iLoopCount)) & " - T" & Trim(Str(26 + iLoopCount))
        iPeopleCount = iPeopleCount + 1
    End If
    iLoopCount = iLoopCount + 1
Loop
 
'*set number of people counter
ThisWorkbook.Sheets("group time").Range("Q25").Value = iPeopleCount
 
End Function