简体   繁体   中英

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

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

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM