Cell Value based on (1) cell colour and (2) second cell content

[scotthannaford1973]

Hi all

hoping that you geniuses can help As per the attached image, I have:

Column B contains either a green or amber cell (hex #92d050 and #ffbf00)
Column C contains either text or blank

Column D, I would like the cells to show the text Approved (if B = 92d050 and C is populated) or Provisional (if B = ffbf00 and C is populated) or be left blank if either B or C are empty.

I understand that this is not possible by formula, but assume it's possible to create some VB that will apply to the range D3:D10?

Hope that makes sense - thanks in advance!

 

[John_w]

Here's one way, with code in the sheet's module. Note - the cell's hex colour is actually a BGR value, so the RGB hex constants must be specified in reverse byte order to match it

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim cell As Range
    
    Application.EnableEvents = False
    For Each cell In Range("B3:B10")
        If Right("00000" & Hex(cell.Interior.Color), 6) = "50D092" And Not IsEmpty(cell.Offset(, 1).Value) Then
            cell.Offset(, 2).Value = "Approved"
        ElseIf Right("00000" & Hex(cell.Interior.Color), 6) = "00BFFF" And Not IsEmpty(cell.Offset(, 1).Value) Then
            cell.Offset(, 2).Value = "Provisional"
        Else
            cell.Offset(, 2).ClearContents
        End If
    Next
    Application.EnableEvents = True
    
End Sub

Unfortunately, the Worksheet_Change event doesn't fire when you change a cell's colour. You could repeat the above code in the Worksheet_SelectionChange routine as a workaround, but it would only fire when you move off the changed cell.

 

[scotthannaford1973]

Here's one way, with code in the sheet's module. Note - the cell's hex colour is actually a BGR value, so the RGB hex constants must be specified in reverse byte order to match it

Private Sub Worksheet_Change(ByVal Target As Range)
   
    Dim cell As Range
   
    Application.EnableEvents = False
    For Each cell In Range("B3:B10")
        If Right("00000" & Hex(cell.Interior.Color), 6) = "50D092" And Not IsEmpty(cell.Offset(, 1).Value) Then
            cell.Offset(, 2).Value = "Approved"
        ElseIf Right("00000" & Hex(cell.Interior.Color), 6) = "00BFFF" And Not IsEmpty(cell.Offset(, 1).Value) Then
            cell.Offset(, 2).Value = "Provisional"
        Else
            cell.Offset(, 2).ClearContents
        End If
    Next
    Application.EnableEvents = True
   
End Sub

Unfortunately, the Worksheet_Change event doesn't fire when you change a cell's colour. You could repeat the above code in the Worksheet_SelectionChange routine as a workaround, but it would only fire when you move off the changed cell.

Hi John

is the cell.offset (, 2) two cells to the right of the first cell that contains the cell colour? thanks for telling me a bout BGR - never knew that!

 

[John_w]

Yes, the cell variable is the column B cell, so cell.offset(,2) is the column D cell on the same row.

 

[maabadi]

How about this UDF.

Function GWIF(Rng1 As Range, Rng2 As Range) As String
Dim R As String
If Rng2.Value <> "" Then
  If Rng1.Interior.Color = 5296274 Then
  R = "Approved"
  ElseIf Rng1.Interior.Color = 49151 Then
  R = "Provisional"
  Else
  R = ""
  End If
Else
R = ""
End If
GWIF = R
End Function

Add it to VBA and Then at Cell D3 ( or each cell you want) Write:

=GWIF(B3,C3)

And Drag it Down.
first Value at formula for Colored Cell & Second it for Project Status Cell Address.
Save it Workbook as Macro-Enabled WOrkbook(.xlsm) or Move Function to Personal Macro Workbook.

 

[scotthannaford1973]

Thanks, John - works beautiflly