Coloring column cells based on values

[Deepk]

Hi team,

I need a macro that fill or not fill color (grey) to the cells of two adjacent columns based on change in values of the second column. Please see the example below. Here both cells in a row are either filled or not filled(including the numbered one).

[TABLE="class: grid, width: 200, align: left"]
<tbody>[TR]
[TD]grey color[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]grey color[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]no color[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]no color[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]no color[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]grey color[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]grey color[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]no color[/TD]
[TD]4[/TD]
[/TR]
</tbody>[/TABLE]

Also, I need second macro that work opposite to the above macro. Means, based on the color filled or not filled it assigns number in the previous column. see example below.

[TABLE="class: grid, width: 200, align: left"]
<tbody>[TR]
[TD]1[/TD]
[TD]grey filled[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]no fill[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]no fill[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]grey filled[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]grey filled[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]grey filled[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]no fill[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]grey filled[/TD]
[/TR]
</tbody>[/TABLE]
Help appreciated!

Thanks
Deepk

 

[Deepk]

Try this one for the second inquiry :

Sub FillNumbers()
    firstVal = 0
    cellColor = 0
    
    For Each c In Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
        
        If c.Interior.Color <> cellColor Then
            firstVal = firstVal + 1
            cellColor = c.Interior.Color
        End If
        Cells(c.Row, 1).Value = firstVal
        
    Next c
End Sub

A heartiest thank you Peter. Both codes are running fine.

 

[Peter_SSs]

A heartiest thank you Peter.

I think you should be thanking louisH for those codes

 

[Deepk]

A heartiest thank you Peter. Both codes are running fine.

Hi LouisH,

I apologies for addressing you as Peter. Thank you very much.

 

[Deepk]

I think you should be thanking louisH for those codes

My Bad. Anyways thanking to you as well for your time.

 

[Peter_SSs]

My Bad. Anyways thanking to you as well for your time.

No problem.

 

[Deepk]

No problem.

Hi Peter,

Could you please help me with this.

https://www.mrexcel.com/forum/excel-questions/1048920-extracting-words-based-two-initial-characters.html

Thank you.

 

[Deepk]

Sub FillGreyColor()
    
    firstVal = 0
    modulo = 0
    
    Range("A:A").Interior.Color = xlNone
    
    For Each c In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
        
        If c.Value <> firstVal Then
            modulo = modulo + 1
            firstVal = c.Value
        End If
        
        If modulo Mod 2 = 1 Then
            c.Interior.Color = 12566463
        End If
        
    Next c
End Sub

Hi louisH,

will it be possible to modify this code so that it can work for

work for selected range of cells in a column
color cells including the corresponding cells of next column
remove existing color if any in both columns before color them

Thank you.

 

[louisH]

Hi louisH,

will it be possible to modify this code so that it can work for

work for selected range of cells in a column
color cells including the corresponding cells of next column
remove existing color if any in both columns before color them

Thank you.

Yes I can tinker Something like that :
Changes made :

-It will only work for the selected range of cells
-It will remove color whithin selection
-It will color selection + column to the right of selection

Sub FillGreyColor()
    
    firstVal = 0
    modulo = 0
    
    Dim col As Double
    col = Selection.Column
            
    If Selection.Columns.Count > 1 Then
        MsgBox "Select only 1 column"
        Exit Sub
    End If
    
    Selection.Interior.Color = xlNone
    Selection.Offset(0, 1).Interior.Color = xlNone
    
    For Each c In Selection
        
        If c.Value <> firstVal Then
            modulo = modulo + 1
            firstVal = c.Value
        End If
        
        If modulo Mod 2 = 1 Then
            Range(Cells(c.Row, col), Cells(c.Row, col + 1)).Interior.Color = 12566463
        End If
        
    Next c
    
End Sub