Mudar cor de um elemento da célula

[Wagner.cwb]

Olá Pessoal,

eu tenho um código que coleta dados e insere em uma célula, porém um desses elemento precisa ficar em vermelho, conforme o exemplo abaixo:

31 *23 * 11

Tentei gravar uma macro, porém ela pinta de vermelho todos os elementos...

A parte do código para formar os elementos é simples,

ActiveCell.FormulaR1C1 = EtapaDia & " * " & VerCel

Não tenho dificuldade para saber qual deve ficar em vermelho.
Por favor, podem me auxiliarem?

Obrigado, abs!
Segue o código na integra:

Anexei uma planilha básica de teste, nela a ideia é deixar em vermelho os números ímpares, só para entender como fazer para minha real necessidade.

MUDAR FONTE.rar

(12.28 KiB) Baixado 196 vezes

Código: Selecionar todos

ill = 1
    
    iL = 2
    cont = 1
        
        
    While WPSheetETAPAS.Range("B" & iL).Value <> ""
    
    sDias(cont) = WPSheetETAPAS.Range("B" & iL).Value
    
    iL = iL + 1
    cont = cont + 1
    Wend
    
    cont = 1
    
    iL = 2
    

            While WPSheetCALEND.Range("C" & iL) <> ""
            ValorA = WPSheetCALEND.Range("C" & iL).Value
            ValorB = WPSheetETAPAS.Range("B" & iL).Value
            ValorC = WPSheetCALEND.Range("E" & iL).Value
            ValorD = WPSheetCriterios.Range("I8").Value
            horario = WPSheetCALEND.Range("D" & iL).Text
            'horario = Format(horario, "hh:mm AMPM")
            
                ETAPA = WPSheetCALEND.Range("B" & iL).Value
                
                If iL = 223 Then
               
               teste = iL
               
               End If
                
                contador = WorksheetFunction.CountIfs(WPSheetCALEND.Range("B2:B10000"), ETAPA, WPSheetCALEND.Range("C2:C10000"), ValorA, WPSheetCALEND.Range("E2:E10000"), ValorD, WPSheetCALEND.Range("D2:D10000"), horario)
                                
                If contador > 0 Then
                
               sDias(ill) = ValorA
               EtapaDia = ETAPA
               sDias(cont) = 0
               
               While sDias(ill) = sDias(cont)
               
               cont = cont + 1
               
              'teste = sDias(cont)
               
               WP_ETAPAS.Activate
               Wend
   
    'CERTO
    Columns("B:B").Select
    'ActiveCell.Columns("B:B").EntireColumn.Select
    Selection.Find(What:=ValorA, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Selection.Find(What:=ValorA, After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, 2).Range("A1").Select
    iLAtual = gfLinhaAtual
    VerCel = Range(iLAtual)
    If VerCel <> "" Then
    
    ActiveCell.FormulaR1C1 = EtapaDia & " * " & VerCel
    
    Else
    
      ActiveCell.FormulaR1C1 = EtapaDia
    
    End If
                 
                
                End If
                
                iL = iL + 1
                ValorB = WPSheetETAPAS.Range("B" & iL).Value
                ValorA = WPSheetCALEND.Range("C" & iL).Value
              
            Wend
                                  
                If ValorA = ValorB And ValorC = ValorD Then
            
            End If
            iL = iL + 1
            
        
    iL = iL + 1