Fill In cell colors for Worksheet Function (based on select case & range)

Question

Below is the worksheet setup for a worksheet (Dragdown) function I've created attempting to show a color range. My question is how do I perform a function where my worksheet cell colors change based on the (Select Case Statement) below tied to my current Work_Sheet Change /Set Performance Events.

The current code I have below only generates one color for all cells

Peromance_Message (Work sheet function setup with variable arguments)

Non Preferred Average Name ($D$42 - Text String) column header
Non Preferred Average (D43- Single) data below (Data begins)
Preferred Average Name (E$42- Text String) column header
Preferred Average (E43- Single) data below (data begins)
Column to right of D & E (I drop down Performance_Message Formula)

MODULE

Public Function Performance_Message(NonPreferredAvg As Single _
                                  , NonPreferredAvgname As String _
                                  , PreferredAvg As Single _
                                  , PreferredAvgname As String _
                                  , Optional Outputtype As String _
                                   ) As Variant

    Dim performancemessage As String
    Dim averagedifference As Single
    Dim stravgdif As String
    Dim cellcolor As String

    averagedifference = Abs(NonPreferredAvg - PreferredAvg)
    stravgdif = FormatPercent(averagedifference, 2)

    Select Case PreferredAvg
        Case Is < NonPreferredAvg
            performancemessage = PreferredAvgname & " Is " & stravgdif & " Less Than " & NonPreferredAvgname
            cellcolor = "green"

        Case Is = NonPreferredAvg
            performancemessage = PreferredAvgname & " Equals " & NonPreferredAvgname
            cellcolor = "yellow"

        Case Is > NonPreferredAvg
            performancemessage = PreferredAvgname & " Is " & stravgdif & " Greater Than " & NonPreferredAvgname
            cellcolor = "blue"

        Case Else
            performancemessage = "Something Bad Happened"


    End Select

    If Outputtype = "color" Then
        Performance_Message = cellcolor
    Else
        Performance_Message = performancemessage

    End If

End Function

WORKSHEET

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim myColor As Double
  myColor = 135
  Call SetPerformancecolor(Target, myColor)

End Sub

Private Sub SetPerformancecolor(Target As Range, myColor As Double)
  Target.Interior.Color = myColor
End Sub

See this [answer](http://stackoverflow.com/questions/13705663/excel-user-defined-function-change-the-cells-color). What you are asking cannot be done because UDF's are not allowed to change the worksheet or other cells. - It can be done with a Sub. Conditional formatting is pretty powerful, consider using it. — OldUgly, Apr 21 '16 at 03:48

Karthick Gunasekaran · Answer 1 · 2016-04-29T05:54:27.867

pls try with below

SEE THE CHANGES MARKED IN COMMENT

MODULE

Public Function Performance_Message(NonPreferredAvg As Single _
                                  , NonPreferredAvgname As String _
                                  , PreferredAvg As Single _
                                  , PreferredAvgname As String _
                                  , Optional Outputtype As String _
                                   ) As Variant

    Dim performancemessage As String
    Dim averagedifference As Single
    Dim stravgdif As String
    Dim cellcolor As String
    averagedifference = Abs(NonPreferredAvg - PreferredAvg)
    stravgdif = FormatPercent(averagedifference, 2)
    Select Case PreferredAvg
        Case Is < NonPreferredAvg
            performancemessage = PreferredAvgname & " Is " & stravgdif & " Less Than " & NonPreferredAvgname
            cellcolor = 4 ' changes made  "green"

        Case Is = NonPreferredAvg
            performancemessage = PreferredAvgname & " Equals " & NonPreferredAvgname
            cellcolor = 6 ' changes made  "yellow"

        Case Is > NonPreferredAvg
            performancemessage = PreferredAvgname & " Is " & stravgdif & " Greater Than " & NonPreferredAvgname
            cellcolor = 5 ' changes made  "blue"

        Case Else
            performancemessage = "Something Bad Happened"
    End Select
    If Outputtype = "color" Then
        Performance_Message = cellcolor
    Else
        Performance_Message = performancemessage
    End If
End Function

WORKSHEET

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("F:F")) Is Nothing Then ' changes made
    Dim myColor As Double
    myColor = Target.Value ' changes made
    Call SetPerformancecolor(Target, myColor)
  End If
End Sub

Private Sub SetPerformancecolor(Target As Range, myColor As Double)
    Target.Interior.ColorIndex = myColor ' changes made
End Sub

Proof:

EDIT From Here

As per your questions, below is the code answer

MODULE

Public Function Performance_Message(NonPreferredAvg As Single _
                                  , NonPreferredAvgname As String _
                                  , PreferredAvg As Single _
                                  , PreferredAvgname As String _
                                  , Optional Outputtype As String _
                                   ) As Variant

    Dim performancemessage As String
    Dim averagedifference As Single
    Dim stravgdif As String
    Dim cellcolor As String
   averagedifference = Abs(NonPreferredAvg - PreferredAvg)
    stravgdif = FormatPercent(averagedifference, 2)
    Select Case PreferredAvg
        Case Is < NonPreferredAvg
            performancemessage = PreferredAvgname & " Is " & stravgdif & " Less Than " & NonPreferredAvgname
            cellcolor = 4
        Case Is = NonPreferredAvg
            performancemessage = PreferredAvgname & " Equals " & NonPreferredAvgname
            cellcolor = 6
        Case Is > NonPreferredAvg
            performancemessage = PreferredAvgname & " Is " & stravgdif & " Greater Than " & NonPreferredAvgname
            cellcolor = 5
        Case Else
            performancemessage = "Something Bad Happened"
    End Select
    If IsMissing(Outputtype) Then
        Performance_Message = cellcolor
    Else
        Performance_Message = performancemessage
    End If
End Function

WORKSHEET

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("F:F")) Is Nothing Then
    Dim myColor As Double
    If IsNumeric(Target.Value) = True Then
        myColor = Target.Value
        Call SetPerformancecolor(Target, myColor)
    Else
        Call SetPerformancecolor(Target, 0)
    End If
  End If
End Sub

Private Sub SetPerformancecolor(Target As Range, myColor As Double)
    Target.Interior.ColorIndex = myColor
End Sub

Thank you very much for providing a different view on this (select case) fill question. My initial thought process for synthesizing function outputs to VBE editor code was scattered in nature This particular solution connects the code to a physical range on the worksheet. I consider myself an advanced beginner beginner in VBA, but I'm glad I was close to the finish line. — Brian Sullivan, Apr 21 '16 at 23:41
Question 1- Why do I get a debug mismatch error if I remove Optional/Variant from the parameter Outputype when dragging down the worksheet function formula? (Note: color parameter is part of my worksheet function formula which is matchup to my formulas) — Brian Sullivan, Apr 29 '16 at 02:18
Question 2- After the End Select (case statement) how does VBA know how to connect the dots (code) when connecting otuputype = "color" to Then Perofrmance_message = cell color . It's the outputype= color expression where I would love some feedback. — Brian Sullivan, Apr 29 '16 at 02:18
Question 3- When reviewing the code structure of Private Sub Worksheet_Change am I correct to say the Worksheet Change function is being used because the dragdown event firing is correlated to that event procedure? — Brian Sullivan, Apr 29 '16 at 02:18
Question 4- Does BY val target as range temporary store the case statement data? Question 5- How should i understand the if not Intersect/Is Nothing code in terms of it's functionality related to the target range & the Call SetPerformance procedure? --or asked what is the Worksheet Change Event/Intersect /Is Nothing coding preforming so the Sub procedure below can perform the SEt Performance Code? — Brian Sullivan, Apr 29 '16 at 02:19

Fill In cell colors for Worksheet Function (based on select case & range)

1 Answers1