Results 1 to 8 of 8
  1. #1
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts

    Macro Thick Box Border

    I have a macro that inserts text "Total in Column A three rows after the last item and totals up the value in Col E three rows after the last value

    I have would like to add code that will put a thick box border starting where the text Total has been inserted up to Col E in line with the word Total

    I have written code to do put a thick box border around total aright up to the total value in Col E, but it does nothing. The code that inserts the text "Total" in Col A and the Value in Col E is correct.

    I would also like the border to be cleared at the beginning of the Macro, then text "Total" to be inserted in Col A, The total value to be inserted in Col E and then the thick box border to be inserted

    I have attached my sample data that contains my code

    Your asistance in this regard will be most appreciated
    Attached Files Attached Files

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    You can use the lines:

    Code:
    With Range("A" & Finalrow + 3 & ":E" & Finalrow + 3).Borders(xlEdgeTop)
      .LineStyle = xlContinuous
      .ColorIndex = xlAutomatic
      .Weight = xlThick
    End With
    The line:
    Cells.Borders(xlEdgeTop).LineStyle = xlNone

    will clear the top border on all cells in worksheet and can be added where desired. If you want to clear all the borders:

    Code:
    Dim i As Integer
    With Cells
      For i = xlDiagonalDown To xlInsideHorizontal
        .Borders(i).LineStyle = xlNone
      Next
    End With

    If at some point this code may be used with xl2007 or xl2010 files I would change the line:
    Finalrow = Range("A65536").End(xlUp).Row

    to

    Finalrow = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

    It uses the same principle but will then use 65536 total rows for pre-XL2007 worksheets and use 1048576 rows for XL2007+ worksheets so will get the appropriate number of total rows.

    [I also recommend using Option Explicit (in tools options check "require variable declaration") to force declaring the variable type.]

    Steve

  3. #3
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Howard,

    I agree with all Steve had to say.
    I was working on it while he posted here's an entirely reworked version that should be a little more efficient.
    Code:
    Option Explicit
    
    Sub Totals()
       Dim lFinalRow As Long
       
       ClearTotal
       
       lFinalRow = Range("A" & Rows.Count).End(xlUp).Row 'Works with any version!
       With Range("A" & lFinalRow)
           .Offset(1, 0).Resize(12, 12).ClearContents
           With .Offset(3, 0)
               .Value = "Total Value"
               .Resize(, 5).Font.Bold = True
           End With
           .Resize(, 5).Borders(xlDiagonalDown).LineStyle = xlNone
           .Resize(, 5).Borders(xlDiagonalUp).LineStyle = xlNone
           With .Offset(3, 4)
               .NumberFormat = "#,##0.00;(#,##0.00)"
               .Formula = "=sum(E3:E" & lFinalRow & ")"
           End With
           With Range(.Offset(3, 0), .Offset(3, 4))
           
               With .Borders(xlEdgeLeft)
                   .LineStyle = xlContinuous
                   .ColorIndex = 0
                   .TintAndShade = 0
                   .Weight = xlMedium
               End With
               With .Borders(xlEdgeTop)
                   .LineStyle = xlContinuous
                   .ColorIndex = 0
                   .TintAndShade = 0
                   .Weight = xlMedium
              End With
              With .Borders(xlEdgeBottom)
                  .LineStyle = xlContinuous
                  .ColorIndex = 0
                  .TintAndShade = 0
                  .Weight = xlMedium
              End With
              With .Borders(xlEdgeRight)
                  .LineStyle = xlContinuous
                  .ColorIndex = 0
                  .TintAndShade = 0
                  .Weight = xlMedium
              End With
    
           End With
       End With
    '    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    '    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
                         
    End Sub
    
    Sub ClearTotal()
    
        On Error GoTo NoTotal
        
        Cells.Find(What:="Total Value", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Clear
        
    NoTotal:
    
    End Sub
    Last edited by RetiredGeek; 2011-09-14 at 17:35.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  4. #4
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    RetiredGeek,

    Instead of
    Code:
               With .Borders(xlEdgeLeft)
                   .LineStyle = xlContinuous
                   .ColorIndex = 0
                   .TintAndShade = 0
                   .Weight = xlMedium
               End With
               With .Borders(xlEdgeTop)
                   .LineStyle = xlContinuous
                   .ColorIndex = 0
                   .TintAndShade = 0
                   .Weight = xlMedium
              End With
              With .Borders(xlEdgeBottom)
                  .LineStyle = xlContinuous
                  .ColorIndex = 0
                  .TintAndShade = 0
                  .Weight = xlMedium
              End With
              With .Borders(xlEdgeRight)
                  .LineStyle = xlContinuous
                  .ColorIndex = 0
                  .TintAndShade = 0
                  .Weight = xlMedium
              End With
    You can put it into a loop and shorten it with (air code):
    Code:
    Dim i As Integer
      For i = xlEdgeLeft To xlEdgeRight
        with .Borders(i)
           .LineStyle = xlContinuous
           .ColorIndex = 0
           .TintAndShade = 0
           .Weight = xlMedium
      End With
    Next
    Steve

  5. #5
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Hi Steve & RG

    Thanks for all your input, much appreciated

    Regards

    Howard

  6. #6
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Steve,

    Good one! I didn't think about using the Builtin Excel constants as loop constraints, very clever.

    Howard,

    Here's the code reworked with your suggestion and comments to make the code easier to follow.
    Code:
    Option Explicit
    
    Sub Totals()
    
       ' Calls: Clear Total
       
       Dim lFinalRow As Long
       Dim iBorderNo As Integer
    
       ClearTotal
       
       lFinalRow = Range("A" & Rows.Count).End(xlUp).Row 'Works with any version!
       With Range("A" & lFinalRow)
           With .Offset(3, 0)
               .Value = "Total Value"
               .Font.Bold = True
    '           .Resize(, 5).Font.Bold = True
           End With   '.Offset(3, 0)
           
           .Borders(xlDiagonalDown).LineStyle = xlNone
           .Borders(xlDiagonalUp).LineStyle = xlNone
    '       .Resize(, 5).Borders(xlDiagonalDown).LineStyle = xlNone
    '       .Resize(, 5).Borders(xlDiagonalUp).LineStyle = xlNone
           
           With .Offset(3, 4)
               .NumberFormat = "#,##0.00;(#,##0.00)"
               .Formula = "=sum(E3:E" & lFinalRow & ")"
           End With    '.Offset(3, 4)
           
           With Range(.Offset(3, 0), .Offset(3, 4))
           
              For iBorderNo = xlEdgeLeft To xlEdgeRight
                 With .Borders(iBorderNo)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
              Next   'For iBorderNo
           End With  'Range(.Offset(3, 0), .Offset(3, 4))
           
       End With   'Range("A" & lFinalRow)
                         
    End Sub    'Totals
    
    Sub ClearTotal()
    
       'Called by: Totals
    
        On Error GoTo NoTotal
        
        Cells.Find(What:="Total Value", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Clear
        
    NoTotal:
    
    End Sub   'ClearTotal
    Note: I also copied the statements with Resize() in them then commented one set out and deleted the .Resize() and all still works fine. I don't know if the .Resize() serves a useful purpose in your work or just got there because you were recording macros and they got picked up? If you don't need them just delete the commented out copies. Otherwise, delete the copies w/o the .Resize() then uncomment the others.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  7. #7
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Hi RG

    Thanks for all the help, much appreciated

    Regards

    Howard

  8. #8
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    6,280
    Thanks
    3
    Thanked 191 Times in 177 Posts
    FYI cross-posted here.
    Regards,
    Rory

    Microsoft MVP - Excel

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •