Modify border formatting macro

Attached is an excel sheet that applies thin borders to the cell ranges specified in the vba module.  If you open the file and click the "Add Thin Borders" button, you'll see exactly what I'm talking about.

The code should not be over-riding any medium weight borders with thin weight borders.  However for some reason, the bottom border of Table5 changes from medium weight to thin weight every time I run it.

Any suggestions on how to correct this?  Again, please refer to my attached file.  It will be very easy to understand when you review.  Thanks!
Border-Sample.xlsm
KP_SoCalAsked:
Who is Participating?
 
dlmilleCommented:
PS - This bothered me on the original question, so glad I'm able to make amends.  No need to select cells in the solution (originally, I thought I had to, but then used the mergeArea.Rows.Count to determine number of rows), so this routine is revised - written more properly:

Private Sub applyBorders(wks As Worksheet, startCol As String, startRow As Long, endRow As Long)
Dim chgRng As Range
Dim myCell As Range
Dim numRows As Long
Dim lRow As Long

    lRow = startRow

    Do
        Set myCell = wks.Range(startCol & lRow)
        numRows = myCell.MergeArea.Rows.Count
       
        Set chgRng = Union(wks.Range(startCol & lRow & ":I" & lRow + numRows - 1), wks.Range("K" & lRow & ":Q" & lRow + numRows - 1))
        'chgRng.Select
       If lRow + numRows < endRow Then Call innerBorder(chgRng)
       lRow = lRow + numRows
    Loop Until lRow > endRow - 1
   
End Sub
0
 
dlmilleCommented:
If the last row is merged, it was making a thin line - a bug in the original code.  Now, it checks the row + number of rows in the merged area to see if it extends to the bottom border or not with the command (see bold line below):

Private Sub applyBorders(wks As Worksheet, startCol As String, startRow As Long, endRow As Long)
Dim chgRng As Range
Dim myCell As Range
Dim numRows As Long
Dim lRow As Long

    lRow = startRow

    Do
        Set myCell = wks.Range(startCol & lRow)
        numRows = myCell.MergeArea.Rows.Count
       
        Set chgRng = Union(wks.Range(startCol & lRow & ":I" & lRow + numRows - 1), wks.Range("K" & lRow & ":Q" & lRow + numRows - 1))
        chgRng.Select
       If lRow + numRows < endRow Then Call innerBorder(Selection)        lRow = lRow + numRows
    Loop Until lRow > endRow - 1
   
End Sub



See attached repaired workbook.

Dave
Border-Sample.xlsm
0
 
KP_SoCalAuthor Commented:
No worries at all.  I appreciate the response and the fix. ;-)
0
 
KP_SoCalAuthor Commented:
Hi Dave, sorry, I found some issues.  Please see the attached file.  You'll notice that a thin border is not being applied at the bottom of row 9 and 19.  Maybe another approach would be to go with your first recommendation, and then wrap the outside of the tables with a medium exterior border after all the horizontal thin borders have been applied.

There's a file on this site that accomplishes this (http://www.vbaexpress.com/kb/getarticle.php?kb_id=499), but I'm not sure how to integrate the logic into your code.

Any additional help you can provide is greatly appreciated.  Thanks!


Border-Sample-REVISED.xlsm
0
 
dlmilleCommented:
Private Sub applyBorders(wks As Worksheet, startCol As String, startRow As Long, endRow As Long)
Dim chgRng As Range
Dim myCell As Range
Dim numRows As Long
Dim lRow As Long

    lRow = startRow

    Do
        Set myCell = wks.Range(startCol & lRow)
        numRows = myCell.MergeArea.Rows.Count
       
        Set chgRng = Union(wks.Range(startCol & lRow & ":I" & lRow + numRows - 1), wks.Range("K" & lRow & ":Q" & lRow + numRows - 1))
        'chgRng.Select
      If lRow + numRows <= endRow Then Call innerBorder(chgRng)
       lRow = lRow + numRows
   Loop Until lRow > endRow - 1  
End Sub
Border-Sample-REVISED.xlsm
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.