セルに色を塗る

EXCEL/ACCESS, VBA(マクロ)

エラーや特定のセルに色を塗るマクロです。
VBA

Dim set_data01 As Object
Worksheets("Sheet1").Select
Cells.Interior.ColorIndex = xlNone '###セル色付クリア

Set set_data01 = Worksheets("Sheet1").Range("A1")
Do Until set_data01.Offset(0, 0).Value = ""
    '###A1を基準に、行方向に空白が出るまで繰り返す。

   If set_data01.Offset(0, 0).Value = "りんご" then
      set_data02.Offset(0, 0).Interior.ColorIndex = 3 
      '###りんごを赤
   Else
      set_data02.Offset(0, 0).Interior.ColorIndex = xlNone 
      '###りんご以外は塗り潰し無し
   Endif
   Set set_data01 = set_data01.Offset(1, 0) '###1行下へ移動

Loop

一番最初に色をクリアしているので、xlNone の処理は必要ないです。消さない場合を想定してます。