none
CF Function Based on Adjacent Column Data RRS feed

  • Question

  • In column "D" I have 'Text' values, many of which are the same.  In column "F" I have differing numbers.  How can I get CF for column F to do a graded color scale for each type of text in column "D"

    So the number column in the example below would have a graded color scale for each of triangle, Square, & Circle.

    I am asking a way to have the color dependent on the number value (low to high) for each text name in the other column. For example, normally if you just select the entire column and do a color CF it would look like this example. (each color is progressive independent of the text in the adjacent column.

    Image

    What I am hoping for (I tried, but don't have it exact) is like this.  Notice that for Triangle 70 is yellow because it is the lowest number and 150 is dark green because it is the highest.  Notice that for Square 0.75 is yellow because it is the lowest number 20 is the next up as light green and 30 is the dark green.  Circle happens to be the only one in this example so I colored it in the middle with light green.  I hope this makes more sense.

    Image

    Thanks,

    Doug

    Wednesday, November 16, 2016 10:24 PM

Answers

  • Hi DougK2016,

    you can use the code mentioned below.

    I had set the min , max value by my self for demo.

    you can change it according to your requirement.

    Option Explicit
    
    Sub ChangeColor()
    Dim lRow, MR, cell As Range
    lRow = Range("A" & Rows.Count).End(xlUp).Row
    Set MR = Range("A1:A1" & lRow)
    For Each cell In MR
    If cell.Value = "Circle" Then
        If cell.Offset(0, 1).Value <= 20 Then
        cell.Offset(0, 1).Interior.ColorIndex = 6
        ElseIf cell.Offset(0, 1).Value > 20 And cell.Offset(0, 1).Value <= 50 Then
        cell.Offset(0, 1).Interior.ColorIndex = 4
        Else
        cell.Offset(0, 1).Interior.ColorIndex = 10
        End If
    End If
    If cell.Value = "Triangle" Then
        If cell.Offset(0, 1).Value <= 20 Then
        cell.Offset(0, 1).Interior.ColorIndex = 6
        ElseIf cell.Offset(0, 1).Value > 20 And cell.Offset(0, 1).Value <= 50 Then
        cell.Offset(0, 1).Interior.ColorIndex = 4
        Else
        cell.Offset(0, 1).Interior.ColorIndex = 10
        End If
    End If
    If cell.Value = "Square" Then
        If cell.Offset(0, 1).Value <= 20 Then
        cell.Offset(0, 1).Interior.ColorIndex = 6
        ElseIf cell.Offset(0, 1).Value > 20 And cell.Offset(0, 1).Value <= 50 Then
        cell.Offset(0, 1).Interior.ColorIndex = 4
        Else
        cell.Offset(0, 1).Interior.ColorIndex = 10
        End If
    End If
    
        Next
    End Sub
    
     

    Output:

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Friday, November 18, 2016 9:37 AM
    Moderator

All replies

  • Hi Doug,

    I tested this problem in my environment, and I cannot get the result with CF feature directly, even with formulas.

    I helped you asked Developer team, you can get the result with VBA code.

    I will move your question to Excel for Developer forum:

    https://social.msdn.microsoft.com/Forums/en-US/home?forum=exceldev

    The reason why we recommend posting appropriately is you will get the most qualified pool of respondents, and other partners who read the forums regularly can either share their knowledge or learn from your interaction with us. Thank you for your understanding.


    Regards,
    Emi Zhang
    TechNet Community Support

    Please remember to mark the replies as answers if they helped.
    If you have feedback for TechNet Subscriber Support, contact tnmff@microsoft.com.

    Thursday, November 17, 2016 10:00 AM
  • Hi DougK2016,

    you can use the code mentioned below.

    I had set the min , max value by my self for demo.

    you can change it according to your requirement.

    Option Explicit
    
    Sub ChangeColor()
    Dim lRow, MR, cell As Range
    lRow = Range("A" & Rows.Count).End(xlUp).Row
    Set MR = Range("A1:A1" & lRow)
    For Each cell In MR
    If cell.Value = "Circle" Then
        If cell.Offset(0, 1).Value <= 20 Then
        cell.Offset(0, 1).Interior.ColorIndex = 6
        ElseIf cell.Offset(0, 1).Value > 20 And cell.Offset(0, 1).Value <= 50 Then
        cell.Offset(0, 1).Interior.ColorIndex = 4
        Else
        cell.Offset(0, 1).Interior.ColorIndex = 10
        End If
    End If
    If cell.Value = "Triangle" Then
        If cell.Offset(0, 1).Value <= 20 Then
        cell.Offset(0, 1).Interior.ColorIndex = 6
        ElseIf cell.Offset(0, 1).Value > 20 And cell.Offset(0, 1).Value <= 50 Then
        cell.Offset(0, 1).Interior.ColorIndex = 4
        Else
        cell.Offset(0, 1).Interior.ColorIndex = 10
        End If
    End If
    If cell.Value = "Square" Then
        If cell.Offset(0, 1).Value <= 20 Then
        cell.Offset(0, 1).Interior.ColorIndex = 6
        ElseIf cell.Offset(0, 1).Value > 20 And cell.Offset(0, 1).Value <= 50 Then
        cell.Offset(0, 1).Interior.ColorIndex = 4
        Else
        cell.Offset(0, 1).Interior.ColorIndex = 10
        End If
    End If
    
        Next
    End Sub
    
     

    Output:

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Friday, November 18, 2016 9:37 AM
    Moderator