Excel. Set Colors.

Question

Hello and good day. I need help with the following.

I have two separate lists (columns) filled with numbers. The number of rows is different for each list and the values of each row is different from the other column. However, most values of List1 match with those in List2, just not in the same row. Refer to the following image.

The goal I'm trying to reach is to compare the values of List1 with those of List2, in descending order, have the equivalent values highlighted, BUT have each highlight be of different color, preferably in the RGB color order or by hues (or any other order you may know of, I need ideas). Refer to the following images.

                   ![](https://learn-attachment.microsoft.com/api/attachments/79fc710e-96e2-4c42-a0b9-ed79021d616b?platform=QnA

Answer 1

Try the code below. I have used cell G1 on the worksheet so you can change the Hue increment value and it makes it easy to experiment with. You will see in the code where I have indicated that you can hard code the increment amount.

HSL colours are not directly supported in VBA so it is necessary to convert them to RGB. There is a UDF that I obtained from elsewhere and the link to it is at the top of the UDF. Worth going to the link and read a little more about it. You will see that I edited the UDF at the bottom of it to return an array in lieu of a string and the array elements are used to set the RGB color.

Screen shot of my test worksheet. I have zoomed it so I can get as much as possible on this post.

From your previous post I am assuming that you know how to install and implement the code. However, feel free to get back to me if any questions.

VBA code below the screen shot. (Amended screen shot)

Following code has been edited since initial posting. The called sub has been removed and now the RGB array is only created once for each time the colour is changed which reduces the processing because it reduces the number of calls to the UDF.

An example workbook has been uploaded as a zipped file to the following link. Download and unzip the file.

https://1drv.ms/u/s!ArAXPS2RpafCnjNEQVlqBEQsEjSn

Sub MatchWithColors()

    Dim ws As Worksheet         'Worksheet with data

    Dim rngColB As Range        'Column B (List 1)

    Dim rngColC As Range        'Column C (List 2)

    Dim dteColA As Date         '1st Date of consecutive range of same date in column A

    Dim rngCel As Range         'Loop range for each cell in column B

    Dim rngToFind As Range      'Range searched for in column C

    Dim intHue As Integer

    Dim intSat As Integer

    Dim intLum As Integer

    Dim intHueIncre As Integer  'Amount to increment the Hue with date change

    Dim strFirstAddr As String  'Save the first cell address where value is found

    Dim arrRGB As Variant       'Array for RGB components

    Set ws = Worksheets("Sheet1")   'Edit "Sheet1" to your sheet name

    With ws

        'Remove any existing interior colors

        With .Columns("A:C").Interior

            .Pattern = xlNone

            .TintAndShade = 0

            .PatternTintAndShade = 0

        End With

        Set rngColB = .Range(.Cells(2, "B"), .Cells(.Rows.Count, "B").End(xlUp))    'Assign column B to range variable

        Set rngColC = .Range(.Cells(2, "C"), .Cells(.Rows.Count, "C").End(xlUp))    'Assign column C to range variable

        dteColA = .Cells(2, "A").Value    'Save date of first cell in range to be processed

        intHue = 0          'Initialize Hue

        intSat = 255        'Initialize Sat

        intLum = 170        'Initialize Lum

        'intHueIncre = 6    'Can hard code the increment value here after experimenting with value in cell G1

        intHueIncre = .Cells(1, "G").Value  'Delete this line if hard coded in previous line

    End With

    'Next line create initial array of the RGB components from HSL components (Hue, Sat and Lum)

    arrRGB = HSLtoRGB(intHue, intSat, intLum)

    For Each rngCel In rngColB  'Loop through each cell in column B

        If rngCel.Offset(0, -1).Value <> dteColA Then

            dteColA = rngCel.Offset(0, -1).Value    'Save date when date is different in column A

            intHue = intHue + intHueIncre    'Increment Hue when date changes

            If intHue > 255 Then intHue = 0 'Start again with Hue if goes past 255

            'Next line update the array of the RGB components with new Hue value

            arrRGB = HSLtoRGB(intHue, intSat, intLum)

        End If

        'Search for all cells in Column C that match the cell in column B

        With rngColC

            Set rngToFind = .Find(What:=rngCel.Value, _

                                LookIn:=xlValues, _

                                LookAt:=xlPart, _

                                SearchOrder:=xlByRows, _

                                SearchDirection:=xlNext, _

                                MatchCase:=False, _

                                SearchFormat:=False)

            If Not rngToFind Is Nothing Then   'Not nothing then is something so value found

                strFirstAddr = rngToFind.Address 'Save first address

                'Next line assign the interior color to the rngCel (Column B)

                rngCel.Interior.Color = RGB(arrRGB(1), arrRGB(2), arrRGB(3))

                Do

                    'Next line assign the interior color to the found cells (Column C)

                    rngToFind.Interior.Color = RGB(arrRGB(1), arrRGB(2), arrRGB(3))

                    Set rngCel = .FindNext(rngToFind)   'Find the next matching value in Column C

                    If rngCel Is Nothing Then Exit Sub       'Exit if value not found (Only occurs with FindNext if found values are changed)

                Loop While rngToFind.Address <> strFirstAddr    'When loops around to first address then finished Finding Next so exit

            End If

        End With

    Next rngCel

End Sub

Function HSLtoRGB(Hue As Integer, Saturation As Integer, Luminance As Integer) As Variant

    'Converts HSL to RGB components because HSL is not supported to set colors with VBA

    'Credit to Allen Wyatt at Link: https://excelribbon.tips.net/T013535_Converting_HSL_to_RGB.html

    Dim r As Integer

    Dim g As Integer

    Dim b As Integer

    Dim C As Double

    Dim X As Double

    Dim m As Double

    Dim rfrac As Double

    Dim gfrac As Double

    Dim bfrac As Double

    Dim hangle As Double

    Dim hfrac As Double

    Dim sfrac As Double

    Dim lfrac As Double

    Dim arrRGB(1 To 3) As Variant      'Dimension 1 based array    'Added by OssieMac

    If (Saturation = 0) Then

        r = 255

        g = 255

        b = 255

    Else

        lfrac = Luminance / 255

        hangle = Hue / 255 * 360

        sfrac = Saturation / 255

        C = (1 - Abs(2 * lfrac - 1)) * sfrac

        hfrac = hangle / 60

        hfrac = hfrac - Int(hfrac / 2) * 2 'fmod calc

        X = (1 - Abs(hfrac - 1)) * C

        m = lfrac - C / 2

        Select Case hangle

            Case Is < 60

                rfrac = C

                gfrac = X

                bfrac = 0

            Case Is < 120

                rfrac = X

                gfrac = C

                bfrac = 0

            Case Is < 180

                rfrac = 0

                gfrac = C

                bfrac = X

            Case Is < 240

                rfrac = 0

                gfrac = X

                bfrac = C

            Case Is < 300

                rfrac = X

                gfrac = 0

                bfrac = C

            Case Else

                rfrac = C

                gfrac = 0

                bfrac = X

        End Select

        r = Round((rfrac + m) * 255)

        g = Round((gfrac + m) * 255)

        b = Round((bfrac + m) * 255)

    End If

    'Following edit by OssieMac so an array in lieu of a string is returned from the UDF

    arrRGB(1) = r           'Assign r to 1st array element

    arrRGB(2) = g           'Assign g to 2nd array element

    arrRGB(3) = b           'Assign b to 3rd array element

    HSLtoRGB = arrRGB

End Function

Answer 2

Forgot in my previous post to tell you to post the link to the workbook.

Also just in case you require it, following guidelines to upload a workbook on OneDrive. (If you already use OneDrive and your process for saving to it is different then you can probably start at step 8 to get the link but please zip the file before uploading.)

1. Zip your workbooks. Do not just save an unzipped workbook to OneDrive because the workbooks open with On-Line Excel and the limited functionality with the On-Line version causes problems.
2. To Zip a file: In Windows Explorer Right click on the selected file and select Send to -> Compressed (zipped) folder). By holding the Ctrl key and left click once on each file, you can select multiple workbooks before right clicking over one of the selections to send to a compressed file and they will all be included into the one Zip file.
3. Do not use 3rd party compression applications because I cannot unzip them. I do not clog up my computer with 3rd party apps when there are perfectly good apps supplied with windows.
4. Go to this link.  https://onedrive.live.com
5. Use the same login Id and Password that you use for this forum.
6. Select Upload in the blue bar across the top and browse to the zipped folder to be uploaded.
7. Select Open (or just double click). (Be patient and give it time to display the file after initially seeing the popup indicating it is done.)
8. Right click the file on OneDrive and select Share.
9. Select "Get a Link" from the popup menu.
10. Click in the field displaying the link and Ctrl and A should highlight the entire link and then Copy and Paste the link into your reply on this forum. (I suggest that you avoid the "Copy" button on the "Get a link" screen because it introduces additional steps that are not required.)

Answer 3

This will need VBA code so would you like to upload a workbook to OneDrive with some real data so that I don't have to create dummy data that may or may not be a representation of the real data. A full set of data including dates and typical full number of rows. Just copy the 3 columns (dates and 2 columns of numbers) to another workbook and that will exclude sensitive data (if any). Also if you keep the data in the equivalent columns/position of the real data then that will eliminate the need for you to edit the code to suit your situation.

Is there likely to be any numbers in the first column with no matching numbers in the second column?

What is your regional date format? (eg. d/m/y or m/d/y).

Answer 4

Hello Mac, thank you for replying.

"How do you define this color order with three different values for R, G and B?" What I meant was to establish each cell to follow the next order of color:

You are correct, I thought there may be a pattern between the RGB values that could be set through macros, but after playing around with it on the “Colors” window in Excel, it now appears to complex to identify such patterns. However, when I switched to the “HSL Model” it seems that such order could be easily established by just increasing the value of “Hue” in multiples of 6, leaving “Sat” as 255 and “Lum” as 170 without changing them.

![](https://learn-attachment.microsoft.com/api/attachments/90b247a3-b19a-45a7-9d3c-84851e49cc28?platform=QnA"https://learn-attachment.microsoft.com/api/attachments/dc3c3fba-c273-422f-9df6-e7a6577b949f?platform=QnA" rel="ugc nofollow">

Finally, the multiple 6 (referred in the 2^nd^ paragraph) is chosen since there could be up to 50 matches per day. However, the “H” value in the “HSL Model” reaches a limit of 255, hence the macro needs to include a condition that restarts the “H” value once it reaches 255, even if it's on the same day.

Answer 5

Could be done with VBA code (Macro). However, I am not sure I understand your comment "preferably in the RGB color order". How do you define this color order with three different values for R, G and B?

Also do you really require all of the colors simultaneously or would it be better to select the values one at a time in column A and it will highlight any corresponding values in column B?

If you require all of the colors simultaneously then what is the maximum matches you are likely to require. I am thinking about how well the matches will stand out if there are lots of colors that are not very different to each other.