Amend VBA Code to look at cell value

[hrayani]

Hello Friends,

I am using these below 2 vba codes for content banding

Code 1 for content banding with colors
At this point the code is working fine as it is banding content when a value changes in column # 6
How to tell the code that
1) If Range("C1").value = "customer" then look at column # 6
2) If Range("C1").value = "supplier" then look at column # 7

Sub content_banding()

Application.ScreenUpdating = False
Dim r As Long, val As String, c As Long

Range("B4:N1000").Interior.Color = xlNone

    r = 6
    val = ActiveSheet.Cells(r, 6).Value
  
    For r = 4 To ActiveSheet.Rows.Count
        If IsEmpty(ActiveSheet.Cells(r, 6).Value) Then
            Exit For
        End If

        If ActiveSheet.Cells(r, 6).Value <> val Then
            If c = 20 Then
                c = 19
              
            Else
                c = 20
            End If
        End If

       ActiveSheet.Range("C" & r & ":N" & r).Select
        With Selection.Interior
            .ColorIndex = c
            .Pattern = xlSolid
            .TintAndShade = 0.5
            End With

        val = ActiveSheet.Cells(r, 6).Value
    Next
  
    Application.ScreenUpdating = False
End Sub

Code 2 for content banding with border
At this point the code is working fine as it is banding content when a value changes in column # 6
How to tell the code that
1) If Range("C1").value = "customer" then look at column # 6
2) If Range("C1").value = "supplier" then look at column # 7

Sub horizontal_broders()
 Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
  
    For Each rng In Range("F4:F" & LastRow)
  
        If rng <> rng.Offset(1, 0) Then
            Range("C" & rng.Row & ":N" & rng.Row).Borders(xlEdgeBottom).LineStyle = xlContinuous
            Range("C" & rng.Row & ":N" & rng.Row).Borders(xlEdgeBottom).Weight = xlMedium
     
        End If
        Next rng
End Sub

 

[kvsrinivasamurthy]

Try this revised code

Sub content_banding()

Application.ScreenUpdating = False
Dim r As Long, val As String, c As Long, clm As Long

Range("B4:N1000").Interior.Color = xlNone

If Range("C1").Value = "customer" Then
clm = 6
ElseIf Range("C1").Value = "supplier" Then
clm = 7
End If
    r = 6
    val = ActiveSheet.Cells(r, clm).Value
  
    For r = 4 To ActiveSheet.Rows.Count
        If IsEmpty(ActiveSheet.Cells(r, clm).Value) Then
            Exit For
        End If

        If ActiveSheet.Cells(r, clm).Value <> val Then
            If c = 20 Then
                c = 19
              
            Else
                c = 20
            End If
        End If

       ActiveSheet.Range("C" & r & ":N" & r).Select
        With Selection.Interior
            .ColorIndex = c
            .Pattern = xlSolid
            .TintAndShade = 0.5
            End With

        val = ActiveSheet.Cells(r, clm).Value
    Next
  
    Application.ScreenUpdating = False
End Sub

 

[hrayani]

Try this revised code

Sub content_banding()

Application.ScreenUpdating = False
Dim r As Long, val As String, c As Long, clm As Long

Range("B4:N1000").Interior.Color = xlNone

If Range("C1").Value = "customer" Then
clm = 6
ElseIf Range("C1").Value = "supplier" Then
clm = 7
End If
    r = 6
    val = ActiveSheet.Cells(r, clm).Value
 
    For r = 4 To ActiveSheet.Rows.Count
        If IsEmpty(ActiveSheet.Cells(r, clm).Value) Then
            Exit For
        End If

        If ActiveSheet.Cells(r, clm).Value <> val Then
            If c = 20 Then
                c = 19
             
            Else
                c = 20
            End If
        End If

       ActiveSheet.Range("C" & r & ":N" & r).Select
        With Selection.Interior
            .ColorIndex = c
            .Pattern = xlSolid
            .TintAndShade = 0.5
            End With

        val = ActiveSheet.Cells(r, clm).Value
    Next
 
    Application.ScreenUpdating = False
End Sub

Thanks for the repy

It works but it does not band on the first change.
It starts banding from the 2nd change

Any idea ??