try
Sub Evaluate()
Dim i As Long, iSrt As Long
Dim clrSet&, clr1&, clr2&
clr1 = 0
clr2 = 20
clrSet = clr1
With Worksheets("2013")
iSrt = 2
For i = iSrt To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(i, 5).Value <> .Cells(i + 1, 5).Value Then
'formulas:
.Range(.Cells(i, 15), .Cells(i, 18)).Formula = Array("=SUM(M" & iSrt & ":M" & i & ")", _
"=IF(G" & i & "=0,"""",IF((O" & i & "/G" & i & ">=90%),"""",O" & i & "-(G" & i & "*0.9)))", _
"=IF(G" & i & "=0,"""",IF((O" & i & "/G" & i & ">100%), O" & i & "-G" & i & ",""""))", _
"=Count(M" & iSrt & ":M" & i & ")")
'backcolor:
.Range("A" & iSrt & ":R" & i).Interior.ColorIndex = clrSet
If clrSet = clr1 Then clrSet = clr2 Else clrSet = clr1
iSrt = i + 1
End If
Next i
End With
End Sub
Bookmarks