Conditional Formatting periodically using VBA macro

Sub conditionsuperfinal()

Sheets("conditionalformattingvba").Select

Dim dict As Object 'Declare a generic Object reference

Set dict = CreateObject("Scripting.Dictionary") 'Late Binding of the Dictionary

Range("T2").Select

While ActiveCell.Value <> ""

Dim key, val

key = ActiveCell.Value: val = ActiveCell.Offset(0, 1).Address

'Add item to VBA Dictionary

If Not dict.Exists(key) Then

    dict.Add key, val

End If

ActiveCell.Offset(1, 0).Select

Wend

'Debug.Print dict.Count 'Result: 1

'

'Debug.Print dict.Exists("North")

'For Each key In dict.Keys

'   Debug.Print key

'Next key

'

''Print all items

'For Each val In dict.Items

'   Debug.Print val

'Next val

'copy format of cells where condition matches

'Dim tempaddress As String

'Range("V2").Select

'tempaddress = Selection.Address

'For Each val In dict.Items

'

'Range(val).Select

'Selection.Copy

'Range(tempaddress).PasteSpecial Paste:=xlPasteFormats

'tempaddress = ActiveCell.Offset(1, 0).Address

'

'Next val

'Application.CutCopyMode = False

Sheets("conditionalformattingvba").Select

Dim workingrange, cell As Range

Range("I2").CurrentRegion.Select

Set workingrange = Selection

Selection.ClearFormats

For Each cell In workingrange

For Each key In dict.Keys

If InStr(1, cell.Value, key, vbTextCompare) > 0 Then

Range(dict(key)).Select

Selection.Copy

cell.PasteSpecial Paste:=xlPasteFormats

Exit For

Else

cell.ClearFormats

End If

Next key

'Debug.Print cell.Address

Next cell

'Dispose of VBA Dictionary

Set dict = Nothing

Application.CutCopyMode = False

End Sub

Sub formatandclear()

Sheets("conditionalformattingvba").Select

Dim workingrange, cell As Range

Range("I2").CurrentRegion.Select

Set workingrange = Selection

'MsgBox (Selection.Rows.Count)

'MsgBox (Selection.Columns.Count)

Dim startrow, startcolumn As Integer

startrow = Range("I2").Row

'MsgBox (startrow)

startcolumn = Range("I2").Column

'MsgBox (startcolumn)

Dim signal As Boolean

signal = False

If (Cells(startrow, startcolumn).Interior.ColorIndex <> 2) And (Cells(startrow, startcolumn).Font.ColorIndex <> 1) Then

For i = 1 To Selection.Rows.Count

For j = 1 To Selection.Columns.Count

    

    Cells(i + (startrow - 1), j + (startcolumn - 1)).Interior.ColorIndex = 2

    Cells(i + (startrow - 1), j + (startcolumn - 1)).Font.ColorIndex = 1

    

Next j

Next i

Else

conditionsuperfinal

End If

End Sub

Sub start_time()

Application.OnTime Now + TimeValue("00:00:10"), "formatandclear"

End Sub

Sub end_time()

Application.OnTime Now + TimeValue("00:00:05"), "formatandclear", False

End Sub

Sub BlinkCell()

'Dim CellToBlink As Range

'Set CellToBlink = Range("H1")

Do While (True)

formatandclear

Application.Wait (Now + TimeValue("0:00:01"))

formatandclear

Application.Wait (Now + TimeValue("0:00:01"))

DoEvents

If Range("D1").Value = 1 Then Exit Do

Loop

End Sub