How to format table with varying number of ro

Microsoft Excel 2003 (full product)
August 3, 2010 at 12:43:01
Specs: Windows 7
Hello!

So I have to take data from multiple tables that all have a varying number of rows, but I want the copied and re-formatted table to all maintain the same layout.

For example, here is an example of one of the raw data tables:

Name of Refinery				
Title of Report				
Crude		Average	08Q3	08Q2
	Type A	x	x	
	Type B	x		x
	Type C	x	x	
	Type D	x	x	x
	TOTAL CRUDE	x	x	x
				
Other Feeds				
	IP 1	x	x	
	IP 2	x		x
	TOTAL OTHER FEEDS	x	x	x
				
	TOTAL INPUTS	x	x	x

And I copy and paste the data into a separate worksheet and arrange it so it is easy to read (like I format using BOLDS for the TOTALs, and highlight each separate section, like CRUDE, with a different background color).
The problem is that I want to format many of these tables in the exact same manner (so that the CRUDES section of the table always has the same background color and border) but from one raw data table to the next, the number of crudes and/or feeds change (so the number of rows that need to be highlighted and colored accordingly change as well)

What code can I use to ensure that if I were to format ANY table (regardless of varying crude and/or feed row number) that they would all have the same general format?

So Row starting with Crude down to Row contained TOTAL CRUDE has a border around it and is a certain bacgrkound color (and totals are bold)
Row starting with OTHER FEEDS down to Row containing TOTAL FEEDS has a border around it and is another different bg color (And totals are bold)
Row containing TOTAL INPUTS has yet another border and another different bg color
(but the number of crude in the list and the number of feeds in the list always vary)

Thank you!


See More: How to format table with varying number of ro

Report •


#1
August 5, 2010 at 13:40:19
Hi,

Here is a macro that will cope with a standard layout report but with different numbers of rows in the 'Crude' and 'Other Feeds' sections and different numbers of columns - i.e. more quarters.

The macro starts by testing to see that only the top left cell - the one containing the text "Name of Refinery" is selected.
I assumed that the actual name would go in the next column, so the first cell is always the same.
As changes made by macros cannot be undone with the Undo command, you want to be pretty sure that you are starting in the right place, although you can select the range of cells and do Edit - Clear - Formats if it goes wrong.

The macro creates four ranges:
Header, Crude, Other Feeds and Total

Each of the four ranges can be formatted differently, and for the 'Crude' and 'Other Feeds' sections, the first and last lines can be individually formatted.

Finally the width of the first column is set, and then another width is applied to all remaining columns

The two rows in the header have their cells merged across the top of the table with centered text.

The formating I have used is only meant as a basis for your own design, and I selected colours etc. to show the main effects and the sections.

Note that the macro relies on finding an exact match in the first column of the table for:
Name of Refinery
Crude
TOTAL CRUDE
Other Feeds
TOTAL OTHER FEEDS
TOTAL INPUTS

It also uses two consecutive empty cells in the first column, as the marker for having gone past the end of the table.
If you ever changed the design and had two empty cells in the first column, you would need to change this test.
The macro is currently set to look at a maximum of 50 rows from the start of the table. If tables are never this big, then the value can be reduced, but it won't make any significant difference to the overall speed. However if tables sometimes consist of more than 50 rows, the value will have to be increased.
Here are the two lines of code:

'test if 2 empty cells found - if so exit
If intEmpty > 1 Then Exit For
and ...
'look in a maximum of 50 rows
For n = 1 To 50

The table width is calculated from the entries on the row labeled "Crude". If any cells on that row to the right of the table are not empty, the table formatting will be applied to excess columns.

The tables can be anywhere on any worksheet, they do not have to start in column A.

There is a bug in the code - if there are any merged cells to the left of the table, in rows containing one of the key words listed, the relevant section formatting is applied to more columns than expected. It seems to be down to the way Excel calculates ranges using the offset function.

I have included comments in the main part of the code, but I didn't comment the individual formatting lines - there are a lot of them, and most are self-evident such as:

.Borders(xlInsideVertical)

Here is the macro:

Option Explicit

Sub FormatReports()
Dim wsThis As Worksheet
Dim strAddrArry(5) As String
Dim intCols As Integer
Dim strHead As String
Dim strCrude As String
Dim strOther As String
Dim strTotal As String
Dim intEmpty As Integer
Dim blnMissing As Boolean
Dim n As Integer

'test if cell selected contains 'Name of Refinery'
If Selection.Text <> "Name of Refinery" Then
    MsgBox "You must select the single cell containing:" & _
        vbCrLf & _
        "'Name of Refinery'"
        Exit Sub
    Else
    'get workshee
    Set wsThis = Selection.Worksheet
    'save first cell
    strAddrArry(0) = Selection.Address
    'set empty cell counter to zero
    intEmpty = 0
    'find and save 5 named locations
    'look in a maximum of 50 rows
    For n = 1 To 50
        'reset empty cell counter if cell not empty
        If Selection.Offset(n, 0).Text <> "" Then
            intEmpty = 0
        End If
        'test cells for named locations
        Select Case Selection.Offset(n, 0).Text
            Case "Crude"
                'save cell address
                strAddrArry(1) = Selection.Offset(n, 0).Address
            Case "TOTAL CRUDE"
                'save cell address
                strAddrArry(2) = Selection.Offset(n, 0).Address
            Case "Other Feeds"
                'save cell address
                strAddrArry(3) = Selection.Offset(n, 0).Address
            Case "TOTAL OTHER FEEDS"
                'save cell address
                strAddrArry(4) = Selection.Offset(n, 0).Address
            Case "TOTAL INPUTS"
                'save cell address
                strAddrArry(5) = Selection.Offset(n, 0).Address
            Case ""
                'empty cell - increment empty counter
                intEmpty = intEmpty + 1
        End Select
        'test if 2 empty cells found - if so exit
        If intEmpty > 1 Then Exit For
    Next n
    
    'test if we have all five values
    'flag missing=false
    blnMissing = False
    For n = 0 To 5
        If strAddrArry(n) = "" Then blnMissing = True
    Next n
    
    'if missing values give message and exit
    If blnMissing = True Then
        MsgBox "Couldn't find all 5 marker texts"
        Exit Sub
    End If
    
    'get column count - use 'Crude' line
    intCols = wsThis.Range(strAddrArry(1)).Offset(0, _
        Application.Columns.Count - wsThis.Range(strAddrArry(1)).Column - 1) _
        .End(xlToLeft).Column _
        - wsThis.Range(strAddrArry(1)).Column
    
    'create four ranges
        strHead = strAddrArry(0) & ":" & Range(strAddrArry(1)) _
                    .Offset(-1, intCols).Address
        strCrude = strAddrArry(1) & ":" & Range(strAddrArry(2)) _
                    .Offset(0, intCols).Address
        strOther = strAddrArry(3) & ":" & Range(strAddrArry(4)) _
                    .Offset(0, intCols).Address
        strTotal = strAddrArry(5) & ":" & Range(strAddrArry(5)) _
                    .Offset(0, intCols).Address
                    
    'format each range
    '***head***
    With wsThis.Range(strHead)
        .RowHeight = 21
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        'get each of the 2 rows starting at 2nd column
        .Offset(0, 1).Resize(1, intCols).MergeCells = True
        .Offset(1, 1).Resize(1, intCols).MergeCells = True
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = 1
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlNone
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = 48
        End With
        With .Interior
            .ColorIndex = 37
            .Pattern = xlSolid
        End With
        With .Font
            .FontStyle = "Bold"
            .Size = 11
            .ColorIndex = 1
        End With
    End With
    
    '***crude***
    With wsThis.Range(strCrude)
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = 1
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = 48
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = 48
        End With
        With .Interior
            .ColorIndex = 36
            .Pattern = xlSolid
        End With
        With .Font
            .FontStyle = "Normal"
            .Size = 10
            .ColorIndex = 1
        End With
        'first row in range
        With .Rows(1)
            With .Interior
                .ColorIndex = 15
            End With
            With .Font
                .FontStyle = "bold"
                .Size = 11
            End With
        End With
        'last row in range
        With .Rows(wsThis.Range(strCrude).Rows.Count)
            With .Font
                .FontStyle = "bold"
                .Size = 11
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlDouble
            End With
        End With
    End With
    
    '***Other****
    With wsThis.Range(strOther)
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = 1
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = 48
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = 48
        End With
        With .Interior
            .ColorIndex = 35
            .Pattern = xlSolid
        End With
        With .Font
            .FontStyle = "Normal"
            .Size = 10
            .ColorIndex = 1
        End With
        'first row in range
        With .Rows(1)
            With .Interior
                .ColorIndex = 15
            End With
            With .Font
                .FontStyle = "bold"
                .Size = 11
            End With
        End With
        'last row in range
        With .Rows(wsThis.Range(strOther).Rows.Count)
            With .Font
                .FontStyle = "bold"
                .Size = 11
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlDouble
            End With
        End With
    End With
    
    '***totals****
    With wsThis.Range(strTotal)
        .RowHeight = 21
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = 1
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlDouble
            .ColorIndex = 1
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlNone
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = 48
        End With
        With .Interior
            .ColorIndex = 37
            .Pattern = xlSolid
        End With
        With .Font
            .FontStyle = "Bold"
            .Size = 11
            .ColorIndex = 1
        End With
    End With
    
    '***column widths***
    'note: .Range("A1") is an offset within the range .Range(strHead)
    '      it is not a reference to cell A1 on the worksheet
    'first column
    wsThis.Range(strHead).Range("A1").ColumnWidth = 30
    'all remaining columns
    For n = 1 To intCols
        With wsThis.Range(strHead).Range("A1").Offset(0, n).EntireColumn
            .ColumnWidth = 12
        End With
    Next n
End If
End Sub

Have fun

Regards


Report •
Related Solutions


Ask Question