Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("QUESTIONÁRIO")
If Target.Column = 2 Or Target.Column = 3 Then
If Target.Row >= 3 And Target.Row <= sh.Cells(sh.Rows.Count, "A").Row Then
On Error Resume Next
Dim n As Integer: n = sh.Range(sh.Cells(3, 2), sh.Cells(sh.Cells(sh.Rows.Count, "A").End(xlUp).Row, 3)).Cells.SpecialCells(xlCellTypeConstants).Count
If n = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row - 2 Then
Call certoErrado
End If
On Error GoTo 0
End If
End If
End Sub
Public Sub certoErrado()
Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("QUESTIONÁRIO")
Dim rng As Range: Set rng = sh.Range(sh.Cells(3, 1), _
sh.Cells(sh.Cells(sh.Rows.Count, "A").End(xlUp).Row, "A"))
Dim res As Boolean: res = False
'MsgBox rng.AddressLocal
For Each cell In rng
If sh.Cells(cell.Row, "G").Value = "C" Then
If Not IsEmpty(sh.Cells(cell.Row, "B").Value) Then
sh.Cells(cell.Row, "B").Interior.Color = RGB(51, 204, 51)
Else
sh.Cells(cell.Row, "C").Interior.Color = RGB(255, 0, 0)
End If
ElseIf sh.Cells(cell.Row, "G").Value = "E" Then
If Not IsEmpty(sh.Cells(cell.Row, "C").Value) Then
sh.Cells(cell.Row, "C").Interior.Color = RGB(51, 204, 51)
Else
sh.Cells(cell.Row, "B").Interior.Color = RGB(255, 0, 0)
End If
End If
Next cell
End Sub
SEGUE UM EXEMPLO DE RESOLUÇÃO DO PROBLEMA
