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.