How to force excel cells to change colors EXPONENTIALLY?

Question

I need to write a macro such that: I fill in A1 with a black color. Then as I run the macro, A2 should be a little lighter, A3 even lighter... etc until A20 is white. "F5" cell value should control the degree of gradient exponent. The current code changes the color proportionally. When I change values in "F5" (e.g. from 1 to 0.7), what happens is that ALL of those 20 cells ("A1:A20") become EQUALLY darker. And the last cell A20 is not white anymore.

However, I need my fist cell "A1" to be black and the last cell "A20" to be white no matter what... And, the distribution of color for the cells should be EXPONENTIAL, i.e. the darkness difference between A1 and A2 should be TWO times (if "F5"==2) as large as the darkness difference between A3 and A2, etc...

Sub Macro3()

    Dim firstCell As Range 'the first cell, and the cell whose color will be used for all others.
    Dim cellColor As Long 'the cell color that you will use, based on firstCell
    Dim allCells As Range 'all cells in the column you want to color
    Dim c As Long  'cell counter
    Dim tintFactor As Double 'computed factor based on # of cells.
    Dim contrast As Double 'double precision factor for changing the contrast 0= none higher is more

    Set firstCell = Range("A1")
    cellColor = firstCell.Interior.Color
    contrast = Range("F5").Value


    Set allCells = Range("A1:A20")

    For c = allCells.Cells.Count To 1 Step -1
        allCells(c).Interior.Color = cellColor
        allCells(c).Interior.TintAndShade = _
            contrast * (c - 1) / (allCells.Cells.Count -1)

    Next

I can't figure out, what function should I implement above so that the change in color would be exponential, as I change the value for the varialbe contrast in "F5"? // AND

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("F5")) Is Nothing Then
        Call Macro3
    End If
End Sub

Answer 1

You can't have both "the next cell is twice as white" and "the first cell is black and the last cell is white". What you are looking for is something called a "gamma function" - a degree of scaling of numbers from 0 to 255 where the rate at which they get lighter depends on a factor (sometimes called the gamma).

In its basic form, you can use something like:

contrast = ((cellNum-1)/(numCells-1))^gamma

Now, if your gamma is 1, the scaling will be linear. When gamma > 1, the intensity will increase more quickly for the last few cells. When it's less than 1, it will change quickly for the first few cells.

I am assuming in the above that the cellNum goes from 1 to 20, and that numCells is 20. This value of contrast, in the .TintAndShade expression you were using, should give you the effect you are looking for. gamma does not need to be an integer, but if it's < 0 you will get contrast > 1, and that will give you strange results (all white, I imagine).

By the way - rename your macro3 to something more sensible (adjustContrast), and call it with the value of F5 as a parameter:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("F5")) Is Nothing Then
    adjustContrast Target.Value
  End If
End Sub

and

Sub adjustContrast(gamma)
  ... etc

Since it was clear from your comment that I wasn't explicit enough in my original posting, here is complete code, and the results it gives me. Note - this is code to demonstrate the effect of changing gamma on the display, not the exact code you want to use (for example, I loop over four columns and have four different values of gamma):

Sub applyGamma()
Dim ii, jj As Integer
Dim contrast As Double
Dim cellColor, fontColor, fontInvColor As Long
Dim allCells As Range
Dim gamma As Double

On Error GoTo recovery
Application.ScreenUpdating = False
Set allCells = [A2:A21]

' default formatting taken from cell A1
cellColor = [A1].Interior.Color
fontColor = [A1].Font.Color
fontInvColor = 16777215 - fontColor ' use the "inverse" color... sloppy way to always see the numbers

For jj = 1 To 4
  Set allCells = allCells.Offset(0, 1)
  gamma = Cells(1, jj + 1).Value ' pick gamma from the column header
  For ii = 1 To 20 ' loop over all the cells
    contrast = ((ii - 1) / 19) ^ gamma ' pick the contrast for this cell
    allCells.Cells(ii, 1).Interior.Color = cellColor
    allCells(ii, 1).Interior.TintAndShade = contrast
    If contrast > 0.5 Then allCells.Cells(ii, 1).Font.Color = fontInvColor Else allCells(ii, 1).Font.Color = fontColor

  Next ii
  ' repeat for next column:
Next jj

recovery:
Application.ScreenUpdating = True

End Sub

Before I run the code, my screen looks like this (the values in the cells are computed contrast values for the given gamma):

After running it, it looks like this:

As you can see, I added an additional "feature": the coloring of the font is changed to keep things visible. This assumes, of course, that the "template cell" (in my case, A1) has good contrast between font and fill colors.

Answer 2

To have it working exponential you could try to use logic which result with following:

The following code is slightly changed compared to your one:

Sub Macro3_proposal_revers()

Dim firstCell As Range 'the first cell, and the cell whose color will be used for all others.
Dim cellColor As Long 'the cell color that you will use, based on firstCell
Dim allCells As Range 'all cells in the column you want to color
Dim c As Long  'cell counter
Dim tintFactor As Double 'computed factor based on # of cells.
Dim contrast As Integer

Set firstCell = Range("B1")
cellColor = firstCell.Interior.Color
    contrast = Range("F5").Value

Set allCells = Range("B1:B20")

Dim allCellsCount!
allCellsCount = allCells.Cells.Count - 1
Dim newContrast As Double
For c = 1 To allCells.Cells.Count - 1

    allCells(c + 1).Interior.Color = cellColor
    'var 1
    newContrast = (1 - 0.9 ^ (c * (1 + (c / allCellsCount))) * contrast)

    allCells(c + 1).Interior.TintAndShade = newContrast

    'control value- to delete
    allCells(c + 1).Offset(0, 1).Value = allCells(c + 1).Interior.TintAndShade
  Next

End Sub

What is important- look into this line:

    newContrast = (1 - 0.9 ^ (c * (1 + (c / allCellsCount))) * contrast)

where you can do whatever you want, eg. change: (1 + (c / allCellsCount)) into something between 1 to 2 to understand the way of logic. Generally, you could adjust the pace of shading change manipulating this line, especially manipulating with this part of the code: (c * (1 + (c / allCellsCount))