Sunday, May 3, 2020

Conditional formatting using VBA where the conditions and the respective formatting is given,VBA Teacher Kolkata,Sourav Bhattacharya








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