- 0 0
Have you ever wanted to 'set' the colours / fonts etc from conditional formatting ?
If so, the below script should help with turning a selection from dynamic to fixed colours.
The below example - we can set a basic colour scale on a range :
On the home menu > Conditional Formatting > Colour Scales :
You should end up with something like this :
If you change any of the numbers - the colours will adjust responsively :
If you DON'T want the colours changing , as yet, there's no option in Excel to copy/paste or fix the colours to actual background colours.
For example, below I've added a blue background behind the conditional format, and copied/pasted the column formats. Only the blue is copied.
Use the following code in a new module -
Sub SetConditionalFormatting() Dim MyRows As Integer, MyCols As Integer, myAreas As Range, myBlock As Range, XDIM As Long, YDIM As Long, ZDIM As Long Dim StRow, StCol, X, Y, Z As Long ':: VECTOR OF COLUMN,ROW AND AREA ID , WITH TOP-LEFT CORNER Dim MyColArray() As Double ' :: STORE COLORS FOR APPLICATION Dim MyAppArray() As Boolean ':: IS COLOUR TO BE APPLIED ? Set myAreas = Selection ':: SET SELECTION TO AREA SET If myAreas.Cells.CountLarge > 500000 Then MsgBox "Cell Count Exceeds 500k. " Exit Sub End If ' :: 500k is the limit of the total cell count if a user has selected the entiire sheet or column ' :: 2147483647 is the maximum from the 'Count' method from Range.Cells ' :: 17179869184 is the maximum count of all cells in an Excel 2007 + Worksheet ZDIM = myAreas.Areas.Count ':: Z = COUNT OF AREAS [CONST ]:: ':: ITERATE THROUGH BLOCKS TO FIND UPPER BOUNDS FOR ARRAY RE-DIMENSIONING :: For Each myBlock In myAreas.Areas If myBlock.Row + myBlock.Rows.Count > XDIM Then XDIM = myBlock.Row + myBlock.Rows.Count - 1 If myBlock.Column + myBlock.Columns.Count > YDIM Then YDIM = myBlock.Column + myBlock.Columns.Count - 1 Next myBlock ':: RESET ARRAY BOUNDS ReDim MyColArray(0 To XDIM + 2, 0 To YDIM + 2, 0 To ZDIM) As Double ReDim MyAppArray(0 To XDIM + 2, 0 To YDIM + 2, 0 To ZDIM) As Boolean Z = 0 ' :: RESET AREA COUNT :: For Each myBlock In myAreas.Areas ' ' :: COLUMNS UPPER AND LOWER BOUNDS ' StCol = myBlock.Column MyCols = StCol + myBlock.Columns.Count - 1 ' ' :: ROWS UPPER AND LOWER BOUNDS ' StRow = myBlock.Row MyRows = StRow + myBlock.Rows.Count - 1 ':: GET COLOURS LOOP For Y = StCol To MyCols For X = StRow To MyRows If Cells(X, Y).FormatConditions.Count > 0 Then ':: STORE THE COLOUR AND STATE ( HAS CONDITIONAL FORMATTING TRUE/FALSE ) INTO ARRAYS MyColArray(X, Y, Z) = Cells(X, Y).DisplayFormat.Interior.Color MyAppArray(X, Y, Z) = True End If Next X Next Y Next myBlock Z = 0 ' :: RESET AREA COUNT :: ':: APPLY COLOURS LOOP :: For Each myBlock In myAreas.Areas StRow = myBlock.Row MyRows = StRow + myBlock.Rows.Count - 1 For Y = StCol To MyCols For X = StRow To MyRows ':: ONLY APPLY COLOURS IF THE CELL HAD CONDITIONAL FORMATTING :: If MyAppArray(X, Y, Z) = True Then Cells(X, Y).FormatConditions.Delete Cells(X, Y).Interior.Color = MyColArray(X, Y, Z) End If Next X Next Y Next myBlock End Sub
This will work when triggered on any selection. There's a limit of 500k on the amount of cells it'll work on, as it is iterative ( colour scales particularly need to be processed as individual elements due to the diverging colours) .
This subroutine can be called from other subroutines, say if you had a process to copy/paste data and conditional formats between sheets / ranges , and fix once you've posted.
So for example - if you wanted to colour a set of numbers / dates etc. just run the stored procedure, and you can copy / paste formats.
Selection has already had procedure run :
Colour gradient generated by conditional formatting can now be applied to a new range.