CODEWITHSUNDEEP
excelvba
Andrija_Grozdanovic
Andrija_Grozdanovic

Reputation: 7

Dynamic color Gradient

I need help in making some kind of dynamic color scaling in excel. I need to scale one column but based on the values from other column. Actually, I need to reset the color scaling to the second column whenever value on the first column changes.

Upvotes: 0

Views: 431

Answers (1)

chillin
chillin

Reputation: 4486

Unless I've misunderstood, seems like you want value-specific conditional formatting.

  • So all rows in column A that contain value Value1 should have their own colour scale in column B.
  • Similarly, all rows in A that contain value Value2 should have their own colour scale in column B.
  • And so forth for all remaining values in column A.

One approach to do this might involve VBA and consist of the following.

  • You can get all rows where column A contains a certain value (e.g. Value1) with Range.AutoFilter in conjunction with Range.SpecialCells.
  • You can add conditional formatting with Range.FormatConditions.Add.
  • It makes sense to complete the above two steps only once for each unique value. Otherwise, the steps will be completed for every value in column A.
  • You can get code to run when a change occurs in column A using Worksheet_Change event and some conditional IF logic.

Assuming your values in column A are sorted (as they appear to be in the document you've shared), the code might look something like:

Option Explicit

Private Sub ApplyValueSpecificConditionalFormatting(ByVal columnToFormat As Variant)

    Dim filterRangeIncludingHeaders As Range
    Set filterRangeIncludingHeaders = Me.Range("A1", Me.Cells(Me.Rows.Count, columnToFormat).End(xlUp))

    Dim filterRangeExcludingHeaders As Range
    Set filterRangeExcludingHeaders = filterRangeIncludingHeaders.Offset(1).Resize(filterRangeIncludingHeaders.Rows.Count - 1)

    filterRangeExcludingHeaders.Columns(columnToFormat).FormatConditions.Delete ' Prevent redundant/obsolete rules.

    ' In your case, values in column A appear to be sorted. So we can assume that whenever
    ' the current row's value (in column A) is not the same as the previous row's value (in column A),
    ' that we have a new, unique value -- for which we should add a new colour scale in column B.
    ' A better, more explicit way would be to build a unique "set" of values (possibly accomodating
    ' type differences e.g. "2" and 2), and loop through the set.

    Dim inputArray() As Variant
    inputArray = filterRangeIncludingHeaders.Value

    Dim rowIndex As Long
    For rowIndex = (LBound(inputArray, 1) + 1) To UBound(inputArray, 1)
        If inputArray(rowIndex, 1) <> inputArray(rowIndex - 1, 1) Then
            filterRangeIncludingHeaders.AutoFilter Field:=1, Criteria1:=inputArray(rowIndex, 1)

            Dim cellsToFormat As Range

            On Error Resume Next
            Set cellsToFormat = filterRangeExcludingHeaders.Columns(columnToFormat).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0

            If Not (cellsToFormat Is Nothing) Then
                ' Probably best to put the below in its own function.
                With cellsToFormat.FormatConditions.AddColorScale(colorscaleType:=2)
                    .SetFirstPriority
                    .ColorScaleCriteria(1).Type = xlConditionValueLowestValue
                    .ColorScaleCriteria(1).FormatColor.Color = vbWhite
                    .ColorScaleCriteria(2).Type = xlConditionValueHighestValue
                    .ColorScaleCriteria(2).FormatColor.Color = 8109667
                End With
            End If

            Set cellsToFormat = Nothing
        End If
    Next rowIndex

    Me.AutoFilterMode = False
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 Then
        ApplyValueSpecificConditionalFormatting columnToFormat:=2 ' or B
        ApplyValueSpecificConditionalFormatting columnToFormat:="C" ' or 2
    End If
End Sub

The code should be placed in the code module of the worksheet (containing values in column A and colour scales in column B).

Upvotes: 2

Related Questions