VBA - Content Banding

[hrayani]

Hi,

I am using the below code for content banding whenever a value changes in column B

Can anybody please amend the code to look at visible rows. Like when data is filtered.

Sub Colorize()

Dim r As Long, val As Long, c As Long


    r = 1
    val = ActiveSheet.Cells(r, 2).Value
    c = 34                                 


    For r = 6 To ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
        If ActiveSheet.Cells(r, 2).Value <> val Then
            If c = 34 Then
                c = 19
            Else
                c = 34
            End If
        End If


        ActiveSheet.Range("A" & r & ":H" & r).Select
        With Selection.Interior
            .ColorIndex = c
            .Pattern = xlSolid
        End With
        val = ActiveSheet.Cells(r, 2).Value
    Next r
    
    End Sub

Any help would be appreciated.

Regards,

Humayun

 

[Peter_SSs]

But I just wanted to know from where the Start Column is triggered in the code

The existing code starts from column A. There are many ways to specify columns C:I, but one way would be to change just this line in the code

With Rows(r).Resize(, 7).Offset(, 2).Interior
  .ColorIndex = c
  .Pattern = xlSolid
End With

Rows(r) is the entire row.
Resize(,7) makes it just 7 columns (A:G)
Offset(,2) moves that right 2 columns so that it is C:I

 

[hrayani]

Thanks very much Peter for your help

I tried changing the starting column and its just working PERFECT

Thanks once again

EDIT

Just one more thing. Cant we use colors in the code like this
I just recorded a macro to color 2 cells

Sub colorcell()

    Range("E2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Range("E3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
End Sub

 

[Peter_SSs]

Thanks very much Peter for your help

I tried changing the starting column and its just working PERFECT

You're welcome.

Just one more thing. Cant we use colors in the code like this

Yes you can if you want. I just used ColorIndex and Pattern because that is what you had in your original code in post 1.

 

[hrayani]

You're welcome.

Yes you can if you want. I just used ColorIndex and Pattern because that is what you had in your original code in post 1.

Would you please let me know how to add two colors in the code

I tried amending this part of the code

With Rows(r).Resize(, 8).Offset(, 0).Interior        .ColorIndex = c
        .Pattern = xlSolid
[COLOR=#ff0000]        .ThemeColor = xlThemeColorAccent6[/COLOR]
   [COLOR=#ff0000]    .TintAndShade = 0.8      'light or dark shade      [/COLOR]

But this .ThemeColor = xlThemeColorAccent6 applies to the entire table
Whereas I obviously want 2 colors for the content banding

 

[Peter_SSs]

So we are dealing with a formal table (ListObject)? That wasn't mentioned before.

Are you trying to colour all the columns of the table or just some of them? If just some please give more detail.

Which (numbered) column of the table is to be checked for the changing values for banding?

 

[hrayani]

Are you trying to colour all the columns of the table or just some of them? If just some please give more detail.

All Columns of the table.

Which (numbered) column of the table is to be checked for the changing values for banding?

Its Column B & its doing that perfect
And if I am not wrong I will have to change this part of the code if I want lets say Column C to be checked for banding

If Cells(r, [COLOR=#ff0000][B]3[/B][/COLOR]).Value <> val Then       
           c = 53 - c
           val = Cells(r, [COLOR=#ff0000][B]3[/B][/COLOR]).Value

 

[Peter_SSs]

So, back to the 'themes' idea, is something like this any use.
Adjust the table name in the code to match yours.

Sub BandVisibleInTable()
  Dim val As Variant
  Dim Rw As ListRow
  Dim ThisStyle As String
  
  val = Chr(1)
  ThisStyle = "20% - Accent6"
  For Each Rw In ActiveSheet.ListObjects("Table2").ListRows '<- Check your table name
    If Not Rw.Range.EntireRow.Hidden Then
      If Rw.Range.Cells(2).Value <> val Then
        ThisStyle = (8 - Left(ThisStyle, 1)) & "0% - Accent6"
        val = Rw.Range.Cells(2).Value
      End If
      Rw.Range.Style = ThisStyle
    End If
  Next Rw
End Sub

 

[hrayani]

Hi Peter,

Sorry for a late reply. Its giving debug message because the data I have is not a table. Just normal data.

Can't we specify a range in the code ??

This is highlighted when degug message appears

[COLOR=#333333]For Each Rw In ActiveSheet.ListObjects("Table2").ListRows [/COLOR][COLOR=#008000][B]'<- Check your table name[/B][/COLOR]

 

[Peter_SSs]

Try this then

Sub BandVisibleInTable_v2()
  Dim val As Variant
  Dim Rw As Range
  Dim ThisStyle As String
  
  val = Chr(1)
  ThisStyle = "20% - Accent6"
  For Each Rw In Range("J55:L73").Rows
    If Not Rw.EntireRow.Hidden Then
      If Rw.Cells(2).Value <> val Then
        ThisStyle = (8 - Left(ThisStyle, 1)) & "0% - Accent6"
        val = Rw.Cells(2).Value
      End If
      Rw.Style = ThisStyle
    End If
  Next Rw
End Sub

 

[hrayani]

Thanks Peter for your help and support. Your code is working PERFECT

In this code I just wanted the code to look at the last used row & yesterday I started a thread in which I needed the code to look at the last used row. A solution was provided by Joe which worked perfect. I just copied few things from that code to this one.

Changes in red

Sub BandVisiblenew()[COLOR=#ff0000]  
  Dim lr As Long[/COLOR]
  Dim val As Variant
  Dim Rw As Range
  Dim ThisStyle As String
  
[COLOR=#ff0000]  lr = Cells(Rows.Count, "A").End(xlUp).Row[/COLOR]
  
  val = Chr(1)
  ThisStyle = "20% - Accent6"
[COLOR=#ff0000]  For Each Rw In Range("A6:H" & lr).Rows[/COLOR]
    If Not Rw.EntireRow.Hidden Then
      If Rw.Cells(2).Value <> val Then
        ThisStyle = (8 - Left(ThisStyle, 1)) & "0% - Accent6"
        val = Rw.Cells(2).Value
      End If
      Rw.Style = ThisStyle
    End If
  Next Rw
End Sub

Please have a look at it and let me know if the changes are OK - working perfect though