?
Solved

Macro to format borders within tables in Excel file

Posted on 2011-10-29
2
Medium Priority
?
336 Views
Last Modified: 2012-05-12
Calling all experts on this one.  Attached is a workbook that contains three different tables on the worksheet.  The number of rows these tables could contain could vary from month to month.  As a result, I continuously need to manually remove and reapply the appropriate horizontal borders.

I’d like to be able to do this automatically with a macro.  Here’s what it would need to do:
1. For all rows in Table1, select each cell in column C and apply a thin border (xlThin) to range C:J, L, and N:P that do NOT have a medium border (xlMedium).

2. For all rows Table2 and TableZ, select each cell in column B and apply a thin border (xlThin) to range B:J, L, and N:P that do NOT have a medium border (xlMedium).

The ‘AfterUpdate’ worksheet in the attached file shows what the expected result would look like.  Any help on this matter would be greatly appreciated.

Here's a link that get's me very close, but still doesn't quite meet my needs: http://www.vbaexpress.com/kb/getarticle.php?kb_id=499

Sample.xls
0
Comment
Question by:KP_SoCal
2 Comments
 
LVL 42

Accepted Solution

by:
dlmille earned 2000 total points
ID: 37052515
Perhaps I'm missing something, or I'm a little puzzled this has been neglected...  At any rate the app searches column C for "Table1", "Table2", and "Table3"

It assumes that the left hand column of each table always has data (e.g., data is contiguous with no blank spaces).  It traverses the left-hand column to identify the top/bottom rows.  The app then selects each appropriate range across the three templates for each of the tables, then applys the thin border, per example in the originally attached file.

Here's the code:
 
Sub UpdateTables()
Dim wkb As Workbook
Dim wks As Worksheet
Dim fRange As Range
Dim topRow As Long
Dim botRow As Long

    Set wkb = ActiveWorkbook
    Set wks = wkb.ActiveSheet
       
    'get Table1 lower and upper bounds
    Set fRange = wks.Range("C:C").Find(what:="Table1", LookIn:=xlValues, lookat:=xlWhole)
    If Not fRange Is Nothing Then
        topRow = fRange.Row + 1
        'navigate down until find a blank/empty cell
        Do
            Set fRange = fRange.Offset(1, 0)
        Loop Until fRange.Value = ""
        
        botRow = fRange.Offset(-1, 0).Row 'assumes contiguous data in column C
        
        Call applyBorders(wks, "C", topRow, botRow)
    Else
        MsgBox "Cannot find out enough on table 1 so aborting", vbCritical
        Exit Sub
    End If
    
    'get table2 lower and upper bounds
    Set fRange = wks.Range("C:C").Find(what:="Table2", LookIn:=xlValues, lookat:=xlWhole)
    If Not fRange Is Nothing Then
        topRow = fRange.Row + 1
        
        Set fRange = fRange.Offset(0, -1)
        'navigate down until find a blank/empty cell
        Do
            Set fRange = fRange.Offset(1, 0)
        Loop Until fRange.Value = ""
        
        botRow = fRange.Offset(-1, 0).Row 'assumes contiguous data in column C
        
        Call applyBorders(wks, "B", topRow, botRow)
    Else
        MsgBox "Cannot find out enough on table 2 so aborting", vbCritical
        Exit Sub
    End If
    
   'get tableZ lower and upper bounds
    Set fRange = wks.Range("C:C").Find(what:="TableZ", LookIn:=xlValues, lookat:=xlWhole)
    If Not fRange Is Nothing Then
        topRow = fRange.Row + 1
        
        Set fRange = fRange.Offset(0, -1)
        'navigate down until find a blank/empty cell
        Do
            Set fRange = fRange.Offset(1, 0)
        Loop Until fRange.Value = ""
        
        botRow = fRange.Offset(-1, 0).Row 'assumes contiguous data in column C
        
        Call applyBorders(wks, "B", topRow, botRow)
    Else
        MsgBox "Cannot find out enough on table Z so aborting", vbCritical
        Exit Sub
    End If
    
End Sub
Sub applyBorders(wks As Worksheet, startCol As String, startRow As Long, endRow As Long)
Dim chgRng 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 & ":J" & lRow + numRows - 1), wks.Range("L" & lRow & ":L" & lRow + numRows - 1), wks.Range("N" & lRow & ":P" & lRow + numRows - 1))
        chgRng.Select
        Call innerBorder(Selection)
        lRow = lRow + numRows
    Loop Until lRow > endRow - 1
    
End Sub
Sub clearTables(rng As Range)

    rng.Borders(xlInsideVertical).LineStyle = xlNone
    rng.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub
Sub innerBorder(rng As Range)

    With rng.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub

Open in new window


See attached.

Enjoy!

Dave
sample-r1.xls
0
 

Author Closing Comment

by:KP_SoCal
ID: 37053791
Dave, home run!  This is precisely what I'm looking to accomplish.  Thanks so much for your help!!
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Ever wonder what it's like to get hit by ransomware? "Tom" gives you all the dirty details first-hand – and conveys the hard lessons his company learned in the aftermath.
Quickbooks hosting can do wonders to your enterprise but considering the points elaborated in the article which will help you to better analyze the outcomes. So scan your business, its needs and then move to the new world of limitless benefits.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…
Look below the covers at a subform control , and the form that is inside it. Explore properties and see how easy it is to aggregate, get statistics, and synchronize results for your data. A Microsoft Access subform is used to show relevant calcul…

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question