You are here:

Excel/Excel VBA Change Conditional Format Line Weight

Advertisement


Question
QUESTION: Hi Damon,

I am using Excel 2007 for Windows.  Level of expertise about 3.  I would like assistance with a VBA workaround solution to change conditional formatted Borders weight from xlThin to xlMedium.

My worksheet consists of multiple columns and dynamically expanding rows.  I need to have a division between certain columns of data.  I provide the division / separation by using a conditional format formula that draws a continuous line (down the right side) between columns when the condition is met.  I use conditional formatting to highlight the change in criteria, and to define a visible separation from one set of criteria to another, with the added benefit that the positions of the lines change dynamically when the criteria is met.  
   
Sheets("Sheet1").Range("D2:AA109").Select
   Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=D$5<>E$5"
   Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
   With Selection.FormatConditions(1).Borders(xlRight)
       .LineStyle = xlContinuous
       .TintAndShade = 0
       .Weight = xlThin
   End With
   Selection.FormatConditions(1).StopIfTrue = False

Call Frmt   ‘Code to try and change line weight for Borders(xlRight) from xlThin to xlMedium.

The above code visibly separates the columns of data which is great, but I would like to change the line weight to xlMedium.

I have tried a few things including the following non-working code:

Sub Frmt()
   Dim col As Range
   
   Sheets("Sheet1").Range("D2:AA109").Select
   
   For Each col In Selection.Columns
   
   With Range("D2:AZ109")
   
   If .Borders.LineStyle = xlContinuous Then
      .Borders(xlEdgeRight).Weight = xlMedium
      .Borders.TintAndShade = 0
   End If
   End With
   Next col
End Sub

Hope you can help.

Thanks,
Sam

ANSWER: Hi Sam,

I believe this code should accomplish what you want.  It sets the line weight to medium if D5 = E5, otherwise thin.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Row = 5 Then
     If Target.Column = 4 Or Target.Column = 5 Then
        Dim Col     As Range
        If Range("D5") = Range("E5") Then
         For Each Col In Range("D2:AA109")
         Col.Borders(xlEdgeRight).Weight = xlMedium
         Next Col
        Else
         For Each Col In Range("D2:AA109")
         Col.Borders(xlEdgeRight).Weight = xlThin
         Next Col
        End If
     End If
  End If
End Sub

This code should be put in the worksheet's event code module.  To do this right-click on the worksheet's tab, select View Code, and paste my code into the Code pane.

I hope I am correctly interpreting your question, but if not feel free to follow up with some clarification and I'll try again.

I could have worked with the conditional formatting, but chose to use the worksheet Change event because it requires only a few lines of code and doesn't add overhead to your file by requiring conditional formatting (or changing the formatting rules) of thousands of cells.

Damon

---------- FOLLOW-UP ----------

QUESTION: Hi Damon,

I appreciate you taking the time to assist me, and provide me with a solution.  I think your code is close to what I need.  However, the formula should be D$5<>E$5 (which I can change).  The logic for my formatting using relative column references is if the adjacent cell has a different value, then a vertical, continuous line of medium weight should be drawn to show the separation between the column values.  

Thus, if D$5<>E$5 – then draw medium weight line down column D Else no line
  If E$5<>F$5 – then draw medium weight line down column E Else no line
  If F$5<>G$5– then draw medium weight line down column F Else no line
  If G$5<>H$5– then draw medium weight line down column G Else no line
  If H$5<>I$5– then draw medium weight line down column H Else no line
  If I$5<>J$5– then draw medium weight line down column I Else no line, and so on to, and including column AA.  

The medium weight line should only be drawn if the cell in row 5 of a column has a different value to the cell that is adjacent to it.  The formula logic needs to flow from one cell to another in row 5 – from column D to column AA.

Further assistance is very much appreciated.  Thank you for your help so far.

Sam

ANSWER: Hi again Sam,

Okay, I made a few faulty assumptions, and your clarification was very helpful.  I think I have it this time, but again let me know if I still missed the mark.

Here's the new code:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Row = 5 Then
     Dim Tcol    As Integer
     Tcol = Target.Column
     Select Case Tcol
        Case 4
         'look only at cell to right (column E)
         If Cells(5, "D") <> Cells(5, "E") Then
         Columns("D").Borders(xlRight).Weight = xlMedium
         Else
         Columns("D").Borders(xlRight).LineStyle = xlNone
         End If
        Case 5 To 26
         'check if not equal to cell to the right
         If Cells(5, Tcol) <> Cells(5, Tcol + 1) Then
         Columns(Tcol).Borders(xlRight).LineStyle = xlContinuous
         Columns(Tcol).Borders(xlRight).Weight = xlMedium
         Else
         Columns(Tcol).Borders(xlRight).LineStyle = xlNone
         End If
         
         'check if not equal to cell to the left
         If Cells(5, Tcol) <> Cells(5, Tcol - 1) Then
         Columns(Tcol - 1).Borders(xlRight).LineStyle = xlContinuous
         Columns(Tcol - 1).Borders(xlRight).Weight = xlMedium
         Else
         Columns(Tcol - 1).Borders(xlRight).LineStyle = xlNone
         End If
        Case 27
         'look only at cell to left (column Z)
         If Cells(5, "AA") <> Cells(5, "Z") Then
         Columns("Z").Borders(xlRight).Weight = xlMedium
         Else
         Columns("Z").Borders(xlRight).LineStyle = xlNone
         End If
     End Select
  End If
End Sub

Damon


---------- FOLLOW-UP ----------

QUESTION: Hi Damon,

When I said (line down column):

Thus, if D$5<>E$5 – then draw medium weight line down column D Else no line
If E$5<>F$5 – then draw medium weight line down column E Else no line
If F$5<>G$5– then draw medium weight line down column F Else no line
If G$5<>H$5– then draw medium weight line down column G Else no line
If H$5<>I$5– then draw medium weight line down column H Else no line
If I$5<>J$5– then draw medium weight line down column I Else no line, and so on to, and including column AA.  

I should have said the line to be drawn down my column range from row 2 to row 109, as per my first post.  Now the line is incorrectly drawn from row 1 to row 1048576 .

In addition, the Worksheet Change Event will not trigger as the values in row 5 are copied from another worksheet, and are pasted as values–no user input changes actually occur on the sheet.  Is it possible for you to make cell D5 the trigger for the Change Event for the whole coded routine thus effecting the change for the relevant columns?  I could then change the value in cell D5, and then change it back to trigger the change event.  I apologise for the change event omission from my previous post.  Thank you for your ongoing help.

Sam

Answer
Hi again Sam,

Actually, the Change event will trigger upon a multi-cell paste.  My previous code just hadn't considered this as a possibility.  Here's an update to the code that includes handling for multi-cell pastes as well as the row 2 to 109 issue.  Hopefully this will solve the problem without the need for a cell D5 trigger that you mentioned.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim TI      As Range
  Set TI = Intersect(Target, Range("C5:AA5"))

  If TI Is Nothing Then Exit Sub
  
     Dim C       As Range       'a single cell
     For Each C In TI
      Dim Tcol    As Integer
      Tcol = C.Column
      Select Case Tcol
        Case 4
         'look only at cell to right (column E)
         With Range("D2:D109")
         If Cells(5, "D") <> Cells(5, "E") Then
         .Borders(xlRight).Weight = xlMedium
         Else
         .Borders(xlRight).LineStyle = xlNone
         End If
         End With
        Case 5 To 26
         'check if not equal to cell to the right
         With Range(Cells(2, Tcol), Cells(109, Tcol))
         If Cells(5, Tcol) <> Cells(5, Tcol + 1) Then
         .Borders(xlRight).LineStyle = xlContinuous
         .Borders(xlRight).Weight = xlMedium
         Else
         .Borders(xlRight).LineStyle = xlNone
         End If
         End With
         
         'check if not equal to cell to the left
         With Range(Cells(2, Tcol - 1), Cells(109, Tcol - 1))
         If Cells(5, Tcol) <> Cells(5, Tcol - 1) Then
         .Borders(xlRight).LineStyle = xlContinuous
         .Borders(xlRight).Weight = xlMedium
         Else
         .Borders(xlRight).LineStyle = xlNone
         End If
         End With
        Case 27
         'look only at cell to left (column Z)
         With Range("Z2:Z109")
         If Cells(5, "AA") <> Cells(5, "Z") Then
         .Borders(xlRight).Weight = xlMedium
         Else
         .Borders(xlRight).LineStyle = xlNone
         End If
         End With
     End Select
  Next C
  
End Sub

Damon
About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Damon Ostrander

Expertise

I have extensive experience with VBA programming in Excel 5 through Excel 2013. As a former aerospace engineer with a large aerospace corporation and consultant in a small defense technology services company, I have developed a wide range of applications in VBA, including simulations involving mixed-language programming, satellite orbit mechanics, graphics and animation, and real-time applications. I am interested in moderate to hard VBA-related questions only.

Experience

I have developed and taught several courses in Excel VBA programming and also VBA programming in Office 97, 2000, and 2007. I have developed a number of large technical applications in Excel VBA for use within the aerospace industry.

Education/Credentials
B.S. in Electrical Engineering and Computer Science, University of California, Berkeley.

©2016 About.com. All rights reserved.