Set a Cell background colour with hex value from another cell

[Excelerate3305]

This is my very first post so please be gentle. I was wondering if it is possible to set the background colour of a cell with a hex value that I would enter from an adjacent cell?? I suspect some form of VBA code will be required?

 

[Zot]

I have no idea how you want to trigger the VBA but this is manually triggered

Select a cell and next to the right of selected cell write a 6 digit hex value from 000000 to FFFFFF (representing RGB value for each to digit accordingly)
Alt+F8 and run the macro

Sub ChgColor()

Dim strHex As String

strHex = Selection.Offset(0, 1)
Selection.Interior.Color = HexToRGB(strHex)

End Sub

Function HexToRGB(sHexVal As String) As Long
    
Dim lRed As Long
Dim lGreen As Long
Dim lBlue As Long

lRed = CLng("&H" & Left$(sHexVal, 2))
lGreen = CLng("&H" & Mid$(sHexVal, 3, 2))
lBlue = CLng("&H" & Right$(sHexVal, 2))

HexToRGB = RGB(lRed, lGreen, lBlue)

End Function

 

[Excelerate3305]

Thanks for the VBA code.

I have attached a copy of the spreadsheet I will be using. I would like to enter the Hex# in cell J8 then have the corresponding colour appear in cell K8. I would like to have this repeated for every row that is populated. I will insert a Form Control button in the spreadsheet then assign the VBA macro to it. Will the original VBA code still work??

Thomas Paint.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L
1	Paint Inventory List
2
3	Name:
4	Address:
5	Total Value of Inventory:
6
7	Paint Name:	Item Description	Manufacturer	Serial / ID number	Date Purchased	Where Purchased	Purchase Price	Quantity in Stock	Inventory Value	Hex #	Colour Sample	Notes
8
9
10
11
Sheet1

 

[Marc L]

Attach a worksheet sample with some filled rows at least in particular with the hex color …​

 

[Zot]

Thanks for the VBA code.

I have attached a copy of the spreadsheet I will be using. I would like to enter the Hex# in cell J8 then have the corresponding colour appear in cell K8. I would like to have this repeated for every row that is populated. I will insert a Form Control button in the spreadsheet then assign the VBA macro to it. Will the original VBA code still work??

Thomas Paint.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L
1	Paint Inventory List
2
3	Name:
4	Address:
5	Total Value of Inventory:
6
7	Paint Name:	Item Description	Manufacturer	Serial / ID number	Date Purchased	Where Purchased	Purchase Price	Quantity in Stock	Inventory Value	Hex #	Colour Sample	Notes
8
9
10
11
Sheet1

Here is better way to implement what you want
Put the macro below under Sheet1 module. As you can see the working range is set to Range("J8:J16"). You can change the operating range. Once Enter is pressed, the color to the next cell is produce. No need to have any form to activate.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim strHex As String

If Not Intersect(Range("J8:J16"), Target) Is Nothing Then
    If Target.Value = "" Then
        Target.Offset(0, 1).Interior.Color = xlNone
        Exit Sub
    End If
    strHex = Target.Value
    Target.Offset(0, 1).Interior.Color = HexToRGB(strHex)
Else
    Exit Sub
End If

End Sub

Function HexToRGB(sHexVal As String) As Long
   
Dim lRed As Long
Dim lGreen As Long
Dim lBlue As Long

lRed = CLng("&H" & Left$(sHexVal, 2))
lGreen = CLng("&H" & Mid$(sHexVal, 3, 2))
lBlue = CLng("&H" & Right$(sHexVal, 2))

HexToRGB = RGB(lRed, lGreen, lBlue)

End Function

 

[Marc L]

Here is better way to implement what you want

Yes like I was thinking and maybe directly without HexToRGB …​

 

[Zot]

Yes like I was thinking and maybe directly without HexToRGB …​

Just using available function. No need to invent new ?

 

[Excelerate3305]

Here is better way to implement what you want
Put the macro below under Sheet1 module. As you can see the working range is set to Range("J8:J16"). You can change the operating range. Once Enter is pressed, the color to the next cell is produce. No need to have any form to activate.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim strHex As String

If Not Intersect(Range("J8:J16"), Target) Is Nothing Then
    If Target.Value = "" Then
        Target.Offset(0, 1).Interior.Color = xlNone
        Exit Sub
    End If
    strHex = Target.Value
    Target.Offset(0, 1).Interior.Color = HexToRGB(strHex)
Else
    Exit Sub
End If

End Sub

Function HexToRGB(sHexVal As String) As Long
  
Dim lRed As Long
Dim lGreen As Long
Dim lBlue As Long

lRed = CLng("&H" & Left$(sHexVal, 2))
lGreen = CLng("&H" & Mid$(sHexVal, 3, 2))
lBlue = CLng("&H" & Right$(sHexVal, 2))

HexToRGB = RGB(lRed, lGreen, lBlue)

End Function

Thanks so much. At present I am not sure how many rows I will require. Can the VBA code be changed in order to automatically increase the range as additional rows are inserted??

 

[Marc L]

Yes but it seems you have missed post #4 …​

 

[Zot]

Thanks so much. At present I am not sure how many rows I will require. Can the VBA code be changed in order to automatically increase the range as additional rows are inserted??

I have no idea if you have something else underneath J16. Otherwise you can put J10000 or all the way down to J1048576