Sub to change cell color based on value and match to other cell

[Psynomi]

Hi,
I've had a lot of help from this forum, so first off: thank you!

What I want to do is change the color of a cell depending on the string within that cell and whether or not it matches the string within another cell.
My setup is as follows: I have a table with different DNA sequences in the rows, with a reference sequence in the top row and one nucleotide of that sequence per column (so either A, C, T or G in each cell).

	A	B	C	D	E	F	G
1	Sequence	NT1	NT2	NT3	NT4	NT5	NT6
2	Reference	g	c	c	t	c	a
3	1	g	c	t	t	c	g
4	2	c	c	t	t	c	g
5	3	c	c	c	t	c	a
6	4	g	c	c	t	a	a

<tbody>
</tbody>

I want to match the individual nucleotides to the reference sequence and give the cell a specific color depending on the nucleotide in that cell and whether it matches the reference sequence.
So for example in the top table I'd want B3 to be light yellow to signify "g", because it is the same as B2 (the reference sequence). But I'd want G3 to be bright yellow to signify "g", because it's different from G2.

I've altered a sub I've found in a different thread to do this (see below). As rngValue I'd select B3:G6 in the table above and as rngRef I'd select B2:G2 (this range is always only 1 row).

Sub Color()
    Dim rngValue As Range, rngRef As Range
    Dim strValue As String, strRef As String
    Dim r As Long, c As Long
    
    On Error Resume Next
    Set rngValue = Application.InputBox("Select values to be compared.", "Select value", Type:=8)
    If rngValue Is Nothing Then Exit Sub
    Do
        Set rngRef = Application.InputBox("Select reference values.", "Select reference", Type:=8)
        If rngRef Is Nothing Then Exit Sub
        If rngValue.Columns.Count = rngRef.Columns.Count Then Exit Do
        MsgBox "Reference range must have the same number of columns as Value range", vbExclamation, "Different Size Ranges"
        Set rngRef = Nothing
    Loop
    On Error Resume Next
        
    For c = 1 To rngValue.Colums.Count
        For r = 1 To rngValue.Rows.Count
            strValue = rngValue(r, c).value
            strRef = rngRef(1, c).value
            If strValue = strRef And strValue = "a" Then
                rngValue(r, c).Interior.ColorIndex = 35
                End If
            If strValue <> strRef And strValue = "a" Then
                rngValue(r, c).Interior.ColorIndex = 4
                End If
            If strValue = strRef And strValue = "c" Then
                rngValue(r, c).Interior.ColorIndex = 24
                End If
            If strValue <> strRef And strValue = "c" Then
                rngValue(r, c).Interior.ColorIndex = 5
                End If
            If strValue = strRef And strValue = "g" Then
                rngValue(r, c).Interior.ColorIndex = 36
                End If
            If strValue <> strRef And strValue = "g" Then
                rngValue(r, c).Interior.ColorIndex = 6
                End If
            If strValue = strRef And strValue = "t" Then
                rngValue(r, c).Interior.ColorIndex = 38
                End If
            If strValue <> strRef And strValue = "t" Then
                rngValue(r, c).Interior.ColorIndex = 7
                End If
            If strValue = "." Or strValue = "" Then
                rngValue(r, c).Interior.ColorIndex = 16
                End If
            Next r, c
          
End Sub

It does what it is supposed to do, which is to say the cells get the right color. However, the cells to the left of the column I have selected change color depending on their value, not the column I have actually selected. And if I select multiple columns it still only changes the color of 1 column to left of the first column I selected.

I hope my application is sort of clear. It may seem rather cumbersome to put every nucleotide in its own cell. I've tried changing just the letter color in the string as a whole, but I have so many sequences and they're so long (320 nucleotides) that it's nearly impossible to see the differences in letter color. I'm using it right now as is and it really helps a lot to have the different cell colors, so I'm happy with my system, but it's a lot of work to do all the columns one by one.

For the life of me I can't figure out why it works on the wrong column and why it doesn't work on multiple columns. Can someone here tell me what I've done wrong?

Thank you very much in advance!

 

[sastoka]

Hi There,

any chance you can post a before and after exemple.

I can't quite figure out what you want.

Regards.

 

[ricardov]

I have to say, this is also totally weird for me. For some reason your variable c always reads as 0 and never loops through.

I'm not exactly sure if it's a caching or VBA mechanism issue, but I did find something similar to your issue Excel VBA For loop with variable index not working - Stack Overflow. I played around with your code and best I came up with is defining the bounds of your loop. But for some reason, when I switch it back to your original code, it worked. Anyway, try this...

Sub Color()
    Dim rngValue As Range, rngRef As Range
    Dim strValue As String, strRef As String
    Dim r As Long, c As Long
    
    On Error Resume Next
    Set rngValue = Application.InputBox("Select values to be compared.", "Select value", Type:=8)
    If rngValue Is Nothing Then Exit Sub
    Do
        Set rngRef = Application.InputBox("Select reference values.", "Select reference", Type:=8)
        If rngRef Is Nothing Then Exit Sub
        If rngValue.Columns.Count = rngRef.Columns.Count Then Exit Do
        MsgBox "Reference range must have the same number of columns as Value range", vbExclamation, "Different Size Ranges"
        Set rngRef = Nothing
    Loop
    On Error Resume Next
        
    'Bounds are initially computed to avoid For-Loop variable computation error.
    Dim columnCount As Long, rowCount As Long
    columnCount = rngValue.Columns.Count
    rowCount = rngValue.Rows.Count
    
    For c = 1 To columnCount
        For r = 1 To rowCount
            strValue = rngValue(r, c).Value
            strRef = rngRef(1, c).Value
            If strValue = strRef And strValue = "a" Then
                rngValue(r, c).Interior.ColorIndex = 35
            End If
            If strValue <> strRef And strValue = "a" Then
                rngValue(r, c).Interior.ColorIndex = 4
            End If
            If strValue = strRef And strValue = "c" Then
                rngValue(r, c).Interior.ColorIndex = 24
            End If
            If strValue <> strRef And strValue = "c" Then
                rngValue(r, c).Interior.ColorIndex = 5
            End If
            If strValue = strRef And strValue = "g" Then
                rngValue(r, c).Interior.ColorIndex = 36
            End If
            If strValue <> strRef And strValue = "g" Then
                rngValue(r, c).Interior.ColorIndex = 6
            End If
            If strValue = strRef And strValue = "t" Then
                rngValue(r, c).Interior.ColorIndex = 38
            End If
            If strValue <> strRef And strValue = "t" Then
                rngValue(r, c).Interior.ColorIndex = 7
            End If
            If strValue = "." Or strValue = "" Then
                rngValue(r, c).Interior.ColorIndex = 16
            End If
        Next r, c
          
End Sub

If you ask me why, I have no idea. It's one of those VBA quirks as how I put it. Only thing I know is that - when I step into the code, the "c" variable is not getting the correct value, always starts with 0, with 0 bounds.

If you find this answer helpful, please feel free to Like this post.

 

[Psynomi]

You are amazing! It works!
And now I don't feel so bad I couldn't figure it out myself

Thank you Ricardov!

 

[ricardov]

It caught my interest as well. Logic-wise, the code is correct. Started adding some debug lines and looking at the Local window... and it's weird how c is not picking up the right value.

Just to add, if you get into these types of problem in the future (and there's definitely going to be more with everdearest VBA)... your bestest friends are Debug.Print + Immediate Window, Local Window and Watch Window. All these, you can access from your VBA Window > Views (on top menu).