Highlight range in row based on text value (tick) - can't add border :(

[Usually_Confused]

Hi,

I have successfully used some borrowed code from this 2016 post (Here) to highlight in grey a row, columns B>M specifically, based on a text value "Champagne" in column 'B'.

Thank you to all those in the original post! Very helpful. All good so far. Nice, neat code.

I then wanted to remove all internal borders and set an thick outside border to these highlighted cells. A header, basically.

I amost gave up before posting for help but did eventually manage to get it to work as above. See the difference between Champage (as intended) and Sparkling Wine (before formatting).

But the code is horribly amatuer (which I fully admit to being) as I'm doing each border one-by-one with a macro recording as the starting basis. And I have WHITE,RED,ROSE and SPARKLING WINE to do both in Caps and sentence case. Which is going to make one lengthy, lengthy module if I continue to do it this way. Can anyone suggest how to shorten this, please?

For Each Cell In Range("B10:B" & endrow)
  If Cell.Value = "Champagne" Then
   '  Cell.EntireRow.Interior.ColorIndex = 5
     Cell.Resize(, 12).Interior.Color = RGB(192, 192, 192)
  End If
Next
          
          ' borders Macro
'

    endrow = Range("B" & Rows.Count).End(xlUp).Row
  For Each Cell In Range("B10:B" & endrow)
  If Cell.Value = "Champagne" Then
    Cell.Resize(, 12).Borders(xlDiagonalDown).LineStyle = xlNone
      End If
Next
    endrow = Range("B" & Rows.Count).End(xlUp).Row
    For Each Cell In Range("B10:B" & endrow)
  If Cell.Value = "Champagne" Then
    Cell.Resize(, 12).Borders(xlDiagonalUp).LineStyle = xlNone
      End If
Next
    endrow = Range("B" & Rows.Count).End(xlUp).Row
    For Each Cell In Range("B10:B" & endrow)
  If Cell.Value = "Champagne" Then
    Cell.Resize(, 12).Borders(xlEdgeLeft).LineStyle = xlNone
      End If
Next
    endrow = Range("B" & Rows.Count).End(xlUp).Row
    For Each Cell In Range("B10:B" & endrow)
  If Cell.Value = "Champagne" Then
    Cell.Resize(, 12).Borders(xlEdgeTop).LineStyle = xlNone
      End If
Next
    endrow = Range("B" & Rows.Count).End(xlUp).Row
    For Each Cell In Range("B10:B" & endrow)
  If Cell.Value = "Champagne" Then
    Cell.Resize(, 12).Borders(xlEdgeBottom).LineStyle = xlNone
      End If
Next
    endrow = Range("B" & Rows.Count).End(xlUp).Row
    For Each Cell In Range("B10:B" & endrow)
  If Cell.Value = "Champagne" Then
    Cell.Resize(, 12).Borders(xlEdgeRight).LineStyle = xlNone
      End If
Next
    endrow = Range("B" & Rows.Count).End(xlUp).Row
    For Each Cell In Range("B10:B" & endrow)
  If Cell.Value = "Champagne" Then
    Cell.Resize(, 12).Borders(xlInsideVertical).LineStyle = xlNone
      End If
Next
    endrow = Range("B" & Rows.Count).End(xlUp).Row
    For Each Cell In Range("B10:B" & endrow)
  If Cell.Value = "Champagne" Then
    Cell.Resize(, 12).Borders(xlInsideHorizontal).LineStyle = xlNone
      End If
Next
    endrow = Range("B" & Rows.Count).End(xlUp).Row
    For Each Cell In Range("B10:B" & endrow)
  If Cell.Value = "Champagne" Then
    Cell.Resize(, 12).Borders(xlDiagonalDown).LineStyle = xlNone
      End If
Next
    endrow = Range("B" & Rows.Count).End(xlUp).Row
    For Each Cell In Range("B10:B" & endrow)
  If Cell.Value = "Champagne" Then
    Cell.Resize(, 12).Borders(xlDiagonalUp).LineStyle = xlNone
      End If
Next

    endrow = Range("B" & Rows.Count).End(xlUp).Row
    For Each Cell In Range("B10:B" & endrow)
    If Cell.Value = "Champagne" Then
    Cell.Resize(, 12).Borders(xlEdgeLeft).LineStyle = xlContinuous
        Cell.Resize(, 12).Borders(xlEdgeLeft).ColorIndex = 0
        Cell.Resize(, 12).Borders(xlEdgeLeft).TintAndShade = 0
        Cell.Resize(, 12).Borders(xlEdgeLeft).Weight = xlMedium
    End If
Next
    
    endrow = Range("B" & Rows.Count).End(xlUp).Row
    For Each Cell In Range("B10:B" & endrow)
    If Cell.Value = "Champagne" Then
    Cell.Resize(, 12).Borders(xlEdgeTop).LineStyle = xlContinuous
        Cell.Resize(, 12).Borders(xlEdgeTop).ColorIndex = 0
        Cell.Resize(, 12).Borders(xlEdgeTop).TintAndShade = 0
        Cell.Resize(, 12).Borders(xlEdgeTop).Weight = xlMedium
    End If
Next


'    With Cell.Resize(, 12).Borders(xlEdgeTop)
'        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
'        .Weight = xlMedium
'    End With

    endrow = Range("B" & Rows.Count).End(xlUp).Row
    For Each Cell In Range("B10:B" & endrow)
    If Cell.Value = "Champagne" Then
    Cell.Resize(, 12).Borders(xlEdgeBottom).LineStyle = xlContinuous
        Cell.Resize(, 12).Borders(xlEdgeBottom).ColorIndex = 0
        Cell.Resize(, 12).Borders(xlEdgeBottom).TintAndShade = 0
        Cell.Resize(, 12).Borders(xlEdgeBottom).Weight = xlMedium
    End If
Next

'
'    With Cell.Resize(, 12).Borders(xlEdgeBottom)
'        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
'        .Weight = xlMedium
'    End With
    
    endrow = Range("B" & Rows.Count).End(xlUp).Row
    For Each Cell In Range("B10:B" & endrow)
    If Cell.Value = "Champagne" Then
    Cell.Resize(, 12).Borders(xlEdgeRight).LineStyle = xlContinuous
        Cell.Resize(, 12).Borders(xlEdgeRight).ColorIndex = 0
        Cell.Resize(, 12).Borders(xlEdgeRight).TintAndShade = 0
        Cell.Resize(, 12).Borders(xlEdgeRight).Weight = xlMedium
    End If
Next


'    With Cell.Resize(, 12).Borders(xlEdgeRight)
'        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
'        .Weight = xlMedium
'    End With
    Cell.Resize(, 12).Borders(xlInsideVertical).LineStyle = xlNone
    Cell.Resize(, 12).Borders(xlInsideHorizontal).LineStyle = xlNone
 ' End If
 ' End With
'  End If
'Next

End Sub

Also, the reference word (i.e. Champagne is always in Column 'B' but I'd really like to apply the grey formatting and the thick outside border from Column A if possible. I tried adding +1 and -1 in this bit:
"Cell.Resize(xxxx, 12)" but that didn't work. Any tips on that too would be greatly appreciated!

With thanks,

UsuallyConfused

 

[DanteAmor]

With the LCase function it always compares to lowercase, so it doesn't matter if it's uppercase or lowercase.

Try this:

Sub HighlightRange()
  Dim cell As Range
  
  For Each cell In Range("B10", Range("B" & Rows.Count).End(3))
    Select Case LCase(cell.Value)
      Case LCase("Champagne"), LCase("SPARKLING WINE"), LCase("WHITE WINE"), LCase("Red Wine")
        With cell.Offset(, -1).Resize(, 13)
          .Interior.Color = RGB(192, 192, 192)
          .Borders.LineStyle = xlNone
          .Borders.LineStyle = xlContinuous
          .Borders.Weight = xlMedium
          .Borders(xlInsideVertical).LineStyle = xlNone
        End With
    End Select
  Next
End Sub

 

[Usually_Confused]

With the LCase function it always compares to lowercase, so it doesn't matter if it's uppercase or lowercase.

Try this:

Sub HighlightRange()
  Dim cell As Range
 
  For Each cell In Range("B10", Range("B" & Rows.Count).End(3))
    Select Case LCase(cell.Value)
      Case LCase("Champagne"), LCase("SPARKLING WINE"), LCase("WHITE WINE"), LCase("Red Wine")
        With cell.Offset(, -1).Resize(, 13)
          .Interior.Color = RGB(192, 192, 192)
          .Borders.LineStyle = xlNone
          .Borders.LineStyle = xlContinuous
          .Borders.Weight = xlMedium
          .Borders(xlInsideVertical).LineStyle = xlNone
        End With
    End Select
  Next
End Sub

Amazing! Thank you so much. Works perfectly. And you also fixed the offset to Column A

Me and my colleagues were able to laugh long and loud at my amateur attempt versus your slick, professional version

 

[DanteAmor]

Im glad to help you, thanks for the feedback.