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
