If you zoom in the picture on the right side there are conditions and the formatting
after running the macro the formatting based on the given conditions will be applied on the data
The source code :
Option Explicit
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
'
'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:N19").Select
Set workingrange = Selection
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
Next cell
'Dispose of VBA Dictionary
Set dict = Nothing
End Sub
No comments:
Post a Comment