Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Format underline a range

Posted on 2016-08-11
2
Medium Priority
?
128 Views
Last Modified: 2016-08-12
This is related to solved question https://www.experts-exchange.com/questions/28962735/Make-sub-to-format-and-total-ranges.html

For convenience, I'm attaching the same .xlsx files.

Add bottom borders under 2 total rows
I'd like to add bottom borders on the last 2 rows of each group as shown. I tried to change the code here but it just underlines the first cell of the 2nd row. I'd like to underline that whole row and the cells directly above that.

Add bottom borders under 2 total rows WRONG
Sub AddGroupAndTotalsAndUnderlines()
'
' Run after SeparateGroups
' Put BM's name on bolded line, and add bolded totals for each group.
' Also underline totals. It doesn't work correctly. Just 1 cell is underlined.
'
'
Dim rng As Range
Application.ScreenUpdating = False
For Each rng In Range("A:A").SpecialCells(xlCellTypeConstants, 2).Areas
    If rng.Cells(1).Row <> 1 Then
        rng.Cells(1).Copy rng.Cells(1).Offset(-1, 2)
        With rng.Cells(1).Offset(-1, 2).Font
            .Bold = True
            .Size = 14
            .Name = "Calibri"
        End With
        rng.Cells(rng.Rows.Count + 1).Offset(0, 5).Resize(, 8).FormulaR1C1 = "=SUM(R[-" & rng.Rows.Count & "]C:R[-1]C)"
        rng.Cells(rng.Rows.Count + 1).Offset(0, 5).Resize(, 8).Font.Bold = True
        With rng.Cells(rng.Rows.Count + 1).Offset(0, 5).Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
    End If
Next rng
Application.ScreenUpdating = True
End Sub

Open in new window


For my edification, I'd appreciate also an explanation of my error and how you fixed it. 8-)
Before.xlsx
After.xlsx
0
Comment
Question by:NVIT
2 Comments
 
LVL 28

Expert Comment

by:MacroShadow
ID: 41753344
Change this line:
With rng.Cells(rng.Rows.Count + 1).Offset(0, 5).Borders(xlEdgeBottom)

Open in new window

to this:
With rng.Cells(rng.Rows.Count + 1).Offset(0, 5).Resize(, 8).Borders(xlEdgeBottom)

Open in new window

0
 
LVL 34

Accepted Solution

by:
Subodh Tiwari (Neeraj) earned 2000 total points
ID: 41753376
Please try this.....

Sub AddGroupAndTotalsAndUnderlines()
Dim rng As Range
Application.ScreenUpdating = False
For Each rng In Range("A:A").SpecialCells(xlCellTypeConstants, 2).Areas
    If rng.Cells(1).Row <> 1 Then
        rng.Cells(1).Copy rng.Cells(1).Offset(-1, 2)
        With rng.Cells(1).Offset(-1, 2).Font
            .Bold = True
            .Size = 14
            .Name = "Calibri"
        End With
        rng.Cells(rng.Rows.Count + 1).Offset(0, 5).Resize(, 8).FormulaR1C1 = "=SUM(R[-" & rng.Rows.Count & "]C:R[-1]C)"
        rng.Cells(rng.Rows.Count + 1).Offset(0, 5).Resize(, 8).Font.Bold = True
        With rng.Cells(rng.Rows.Count + 1).Offset(0, 5).Resize(, 8).Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With rng.Cells(rng.Rows.Count + 1).Offset(0, 5).Resize(, 8).Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
    
    End If
Next rng
Application.ScreenUpdating = True
End Sub

Open in new window

0

Featured Post

Get your Disaster Recovery as a Service basics

Disaster Recovery as a Service is one go-to solution that revolutionizes DR planning. Implementing DRaaS could be an efficient process, easily accessible to non-DR experts. Learn about monitoring, testing, executing failovers and failbacks to ensure a "healthy" DR environment.

Question has a verified solution.

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

I came across an unsolved Outlook issue and here is my solution.
Currently, there is an issue with being able to copy values from an external application to a dropdown list in Project Web Access (PWA).  The standard copy and paste methods don't seem to work properly. Here is a way to accomplish this task to s…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

580 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