تلوين خلايا بشرط

[مجاهد2013]

السلام عليكم 

عندي في شيت data2  أريد إعفاء أساتذة مادة معينة يوم إمتحان تلك المادة و الكود المستعمل للأستاذ سليم تحياتي الخالصة له يقوم بهذا العمل و لكن لا يعمل في حالة تكرار نفس المادة مرتين أو ثلاثة في الاسبوع (يعفي الاستاذ الامتحان الاول فقط )

اريد التعديل إن أمكن ... ,وهذا هو الكود المستخدم للأستاذ سليم

Option Explicit
Sub colorize_table()
Application.ScreenUpdating = False
Dim Find_Rg As Range, r%, i%
Dim serch_range As Range
Set serch_range = Sheets("ÇáãÚØíÇÊ").Range("R3:U12")
Dim start_rg As Range
Dim last_ro%: last_ro = Sheets("data2").Cells(Rows.Count, 2).End(3).Row
 Dim k%
  For k = 9 To 18 Step 2
  Cells(6, k).Resize(last_ro - 4).Interior.ColorIndex = 35
  Cells(6, k + 1).Resize(last_ro - 4).Interior.ColorIndex = 24

  Next
i = 7
Do Until Sheets("data2").Range("c" & i) = vbNullString
 Set start_rg = Sheets("data2").Range("H" & i)
  Set Find_Rg = serch_range.Find(Sheets("data2").Range("c" & i))
    If Not Find_Rg Is Nothing Then
   r = Find_Rg.Row - 2
     Else: GoTo Next_i
     End If
 start_rg.Offset(, r).Interior.ColorIndex = 25
Next_i:
 i = i + 1
Loop
Application.ScreenUpdating = True

End Sub

My_File.xlsm