Underline all rows in a dynamic worksheet

T

tharnden

New Member
Joined
Sep 2, 2015
Messages
16
I am trying to underline the rows from row 2 to the end, and double underline the first row. The number of rows can be different each time and the worksheets are between my variables StartIndex and EndIndex. Thanks!

Private Sub CommandButton4_Click()
Dim StartIndex As Long, EndIndex As Long, i As Long
Dim ws As Worksheet
Dim lookupValue As Range
Dim tableArray As Range
StartIndex = Sheets("Invoice").Index + 1
EndIndex = Sheets.Count
Dim intSheet As Integer
Dim arSheets() As String
Dim intArrayIndex As Integer
Dim lastRow As Long
Dim seriesOfRows As Range
Set tableArray = Sheets("Client List").Range("A1:C93")

intArrayIndex = 0


For intSheet = StartIndex To EndIndex
Set lookupValue = Sheets(intSheet).Range("A2")
If Sheets(intSheet).Name <> "Sheet1" Then
Sheets(intSheet).Rows(1).Insert
Sheets(intSheet).Rows(1).Range("D1") = Application.WorksheetFunction.VLookup(lookupValue, tableArray, 2, False)
LastMonth = Format(DateSerial(Year(Date), Month(Date) - 1, 1), "mm-yyyy")
Sheets(intSheet).Columns("A").Delete
With Sheets(intSheet).PageSetup.LeftHeaderPicture
.filename = "S:\Billing\Client billing\LogoDoNotTouch\cpc_302X181.jpg"
.Height = 70
.Width = 120
.Brightness = 0.36
.ColorType = msoPictureAutomatic
.Contrast = 0.59
.CropBottom = 0
.CropLeft = 0
.CropRight = 0
.CropTop = 0
End With
With Sheets(intSheet).PageSetup
.LeftHeader = "&G"
.CenterHeader = Sheets(intSheet).Range("C1")
.RightHeader = "Invoice Detail for " & LastMonth
.RightFooter = "Page &P of &N"
.LeftFooter = "Printed on &D"
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(1.5)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
End With
With Sheets(intSheet)
' lastRow = .UsedRange.Rows.Count
' lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set seriesOfRows = .Range(.Cells(2, 1), .Cells(lastRow, 1))
.Range("A2").Value = "Physician"
.Range("B2").Value = "Accession Number"
.Range("C2").Value = "Patient Name"
.Range("D2").Value = "Collection Date"
.Range("E2").Value = "Procedure (CPT)"
.Range("F2").Value = "Amount"
.Columns("D:F").HorizontalAlignment = xlCenter
.Columns("B").ColumnWidth = 15.67
.Columns("A").ColumnWidth = 20.22
With seriesOfRows
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
.Rows.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Rows(2).Font.Bold = True
.Rows(2).Borders.LineStyle = xlDouble
End With
Sheets(intSheet).Rows(1).Delete
ReDim Preserve arSheets(intArrayIndex)
arSheets(intArrayIndex) = Sheets(intSheet).Name
intArrayIndex = intArrayIndex + 1
End If
Next


' Sheets(arSheets).Select
End Sub
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Sort by date Sort by votes
Please try to use code tags. makes it easier. Also please indent. much easier to read the code.

here is your code in tags and indented.

Code: 
Private Sub CommandButton4_Click()

Dim StartIndex As Long, EndIndex As Long, i As Long, lastRow As Long
Dim ws As Worksheet
Dim lookupValue As Range, tableArray As Range, seriesOfRows As Range
Dim intSheet As Integer, intArrayIndex As Integer
Dim arSheets() As String

    StartIndex = Sheets("Invoice").Index + 1
    EndIndex = Sheets.Count
    
    Set tableArray = Sheets("Client List").Range("A1:C93")
    
    intArrayIndex = 0

    For intSheet = StartIndex To EndIndex
        Set lookupValue = Sheets(intSheet).Range("A2")
        If Sheets(intSheet).Name <> "Sheet1" Then
            Sheets(intSheet).Rows(1).Insert
            Sheets(intSheet).Rows(1).Range("D1") = Application.WorksheetFunction.VLookup(lookupValue, tableArray, 2, False)
            LastMonth = Format(DateSerial(Year(Date), Month(Date) - 1, 1), "mm-yyyy")
            Sheets(intSheet).Columns("A").Delete
            
            With Sheets(intSheet).PageSetup.LeftHeaderPicture
                .Filename = "S:\Billing\Client billing\LogoDoNotTouch\cpc_302X181.jpg"
                .Height = 70
                .Width = 120
                .Brightness = 0.36
                .ColorType = msoPictureAutomatic
                .Contrast = 0.59
                .CropBottom = 0
                .CropLeft = 0
                .CropRight = 0
                .CropTop = 0
            End With
            
            With Sheets(intSheet).PageSetup
                .LeftHeader = "&G"
                .CenterHeader = Sheets(intSheet).Range("C1")
                .RightHeader = "Invoice Detail for " & LastMonth
                .RightFooter = "Page &P of &N"
                .LeftFooter = "Printed on &D"
                .LeftMargin = Application.InchesToPoints(0.5)
                .RightMargin = Application.InchesToPoints(0.5)
                .TopMargin = Application.InchesToPoints(1.5)
                .BottomMargin = Application.InchesToPoints(1)
                .HeaderMargin = Application.InchesToPoints(0.5)
                .FooterMargin = Application.InchesToPoints(0.5)
            End With
            
            With Sheets(intSheet)
                ' lastRow = .UsedRange.Rows.Count
                ' lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
                Set seriesOfRows = .Range(.Cells(2, 1), .Cells(lastRow, 1))
                .Range("A2").Value = "Physician"
                .Range("B2").Value = "Accession Number"
                .Range("C2").Value = "Patient Name"
                .Range("D2").Value = "Collection Date"
                .Range("E2").Value = "Procedure (CPT)"
                .Range("F2").Value = "Amount"
                .Columns("D:F").HorizontalAlignment = xlCenter
                .Columns("B").ColumnWidth = 15.67
                .Columns("A").ColumnWidth = 20.22
                    With seriesOfRows
                        With .Borders(xlEdgeBottom)
                            .LineStyle = xlContinuous
                            .Weight = xlThin
                            .ColorIndex = xlAutomatic
                        End With
                    End With
                .Rows.Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Rows(2).Font.Bold = True
                .Rows(2).Borders.LineStyle = xlDouble
            End With
            
            Sheets(intSheet).Rows(1).Delete
            ReDim Preserve arSheets(intArrayIndex)
            arSheets(intArrayIndex) = Sheets(intSheet).Name
            intArrayIndex = intArrayIndex + 1
        End If
    Next

 ' Sheets(arSheets).Select
 End Sub

based on your code I see that you try and underline and double underline. However the single under line only affects range "SeriesofRows" which is set to only column A from Cells 2 down through your last row of data (which by the way you have commented out the lastrow variable so I would expect you are getting an error)

your double underline looks to be affect row 2 of your data.

I would make the following changes....

change code inside the **** to the code inside the !!!!!!!

Code: 
Private Sub CommandButton4_Click()

Dim StartIndex As Long, EndIndex As Long, i As Long, lastRow As Long
Dim ws As Worksheet
Dim lookupValue As Range, tableArray As Range, seriesOfRows As Range
Dim intSheet As Integer, intArrayIndex As Integer
Dim arSheets() As String
'!!!!!!!!!!!!!!!!!!!!!!!!!!
Dim Lcol As Long
Dim rng As Range
'!!!!!!!!!!!!!!!!!!!!!!!!!!

    StartIndex = Sheets("Invoice").Index + 1
    EndIndex = Sheets.Count
    
    Set tableArray = Sheets("Client List").Range("A1:C93")
    
    intArrayIndex = 0

    For intSheet = StartIndex To EndIndex
        Set lookupValue = Sheets(intSheet).Range("A2")
        If Sheets(intSheet).Name <> "Sheet1" Then
            Sheets(intSheet).Rows(1).Insert
            Sheets(intSheet).Rows(1).Range("D1") = Application.WorksheetFunction.VLookup(lookupValue, tableArray, 2, False)
            LastMonth = Format(DateSerial(Year(Date), Month(Date) - 1, 1), "mm-yyyy")
            Sheets(intSheet).Columns("A").Delete
            
            With Sheets(intSheet).PageSetup.LeftHeaderPicture
                .Filename = "S:\Billing\Client billing\LogoDoNotTouch\cpc_302X181.jpg"
                .Height = 70
                .Width = 120
                .Brightness = 0.36
                .ColorType = msoPictureAutomatic
                .Contrast = 0.59
                .CropBottom = 0
                .CropLeft = 0
                .CropRight = 0
                .CropTop = 0
            End With
            
            With Sheets(intSheet).PageSetup
                .LeftHeader = "&G"
                .CenterHeader = Sheets(intSheet).Range("C1")
                .RightHeader = "Invoice Detail for " & LastMonth
                .RightFooter = "Page &P of &N"
                .LeftFooter = "Printed on &D"
                .LeftMargin = Application.InchesToPoints(0.5)
                .RightMargin = Application.InchesToPoints(0.5)
                .TopMargin = Application.InchesToPoints(1.5)
                .BottomMargin = Application.InchesToPoints(1)
                .HeaderMargin = Application.InchesToPoints(0.5)
                .FooterMargin = Application.InchesToPoints(0.5)
            End With
            
            With Sheets(intSheet)
                ' lastRow = .UsedRange.Rows.Count
                '****************************************************************
                ' lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
                '****************************************************************
                '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
                Lcol = Cells(1, .Columns.Count).End(xlToLeft).Column
                '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                Set seriesOfRows = .Range(.Cells(2, 1), .Cells(lastRow, 1))
                .Range("A2").Value = "Physician"
                .Range("B2").Value = "Accession Number"
                .Range("C2").Value = "Patient Name"
                .Range("D2").Value = "Collection Date"
                .Range("E2").Value = "Procedure (CPT)"
                .Range("F2").Value = "Amount"
                .Columns("D:F").HorizontalAlignment = xlCenter
                .Columns("B").ColumnWidth = 15.67
                .Columns("A").ColumnWidth = 20.22
                '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                Set rng = Range(.Cells(2, 1), .Cells(lrow, Lcol))
                '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                '*******************************************************************
                    With seriesOfRows
                '*******************************************************************
                '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                    With seriesOfRows 'replace code to say with rng
                '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                        With .Borders(xlEdgeBottom)
                            .LineStyle = xlContinuous
                            .Weight = xlThin
                            .ColorIndex = xlAutomatic
                        End With
                    End With
                '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                Set rng = Range(.Cells(1, 1), .Cells(1, Lcol))
                '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                '********************************************************************
                .Rows.Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Rows(2).Font.Bold = True
                .Rows(2).Borders.LineStyle = xlDouble
                '********************************************************************
                '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                rng.Borders(xlEdgeBottom).LineStyle = xlContinuous
                rng.Font.Bold = True
                rng.Borders.LineStyle = xlDouble
                '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
            End With
            
            Sheets(intSheet).Rows(1).Delete
            ReDim Preserve arSheets(intArrayIndex)
            arSheets(intArrayIndex) = Sheets(intSheet).Name
            intArrayIndex = intArrayIndex + 1
        End If
    Next

 ' Sheets(arSheets).Select
 End Sub

should do it.

rich
 
Upvote 0
Thank you Rich! When I run the code, I get Run time error '1004': Application-defined or object-defined error, for this line

Set rng = Range(.Cells(2, 1), .Cells(lrow, Lcol))

I tried putting a dot in front of range, but that did not help.
 
Upvote 0
Change lrow to Lastrow.

Sorry about that my default last row variable is always Lrow. However, you use lastrow and I just typed my range my way. My bad.

Rich
 
Upvote 0
RCBricker said:
Change lrow to Lastrow.

Sorry about that my default last row variable is always Lrow. However, you use lastrow and I just typed my range my way. My bad.

Rich
Click to expand...

Hi Rich,
This does not give me any errors, but it only underlines the last line of the worksheet and not each line. I removed some of the code that is not related to make it easier to read.
Thanks,
Tracy

Code: 
Private Sub CommandButton4_Click()
    Dim StartIndex As Long, EndIndex As Long, i As Long, lrow As Long
    Dim ws As Worksheet
    Dim lookupValue As Range, tableArray As Range, seriesOfRows As Range
    Dim intSheet As Integer, intArrayIndex As Integer
    Dim arSheets() As String
    Dim lcol As Long
    Dim rng As Range
    
    StartIndex = Sheets("Invoice").Index + 1
    EndIndex = Sheets.Count
    
    Set tableArray = Sheets("Client List").Range("A1:C93")
     
    intArrayIndex = 0


    For intSheet = StartIndex To EndIndex
        Set lookupValue = Sheets(intSheet).Range("A2")
        If Sheets(intSheet).Name <> "Sheet1" Then
            Sheets(intSheet).Rows(1).Insert
            Sheets(intSheet).Rows(1).Range("D1") = Application.WorksheetFunction.VLookup(lookupValue, tableArray, 2, False)
            LastMonth = Format(DateSerial(Year(Date), Month(Date) - 1, 1), "mm-yyyy")
            Sheets(intSheet).Columns("A").Delete
            
                        
                       
            Sheets(intSheet).Rows(1).Delete
            
            With Sheets(intSheet)
                lrow = .Range("A" & .Rows.Count).End(xlUp).Row
                lcol = Cells(1, .Columns.Count).End(xlToLeft).Column
                Set seriesOfRows = .Range(.Cells(1, 1), .Cells(lrow, 1))
                Set rng = .Range(.Cells(1, 1), .Cells(lrow, lcol))
                With rng
                    With .Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                End With
                Set rng = .Range(.Cells(1, 1), .Cells(1, lcol))
                   rng.Borders(xlEdgeBottom).LineStyle = xlContinuous
                   rng.Font.Bold = True
                   rng.Borders.LineStyle = xlDouble
            End With
            
            ReDim Preserve arSheets(intArrayIndex)
            arSheets(intArrayIndex) = Sheets(intSheet).Name
            intArrayIndex = intArrayIndex + 1
        End If
    Next


   ' Sheets(arSheets).Select
End Sub
 
Upvote 0
see if this fixes it.

Code: 
Private Sub CommandButton4_Click()
    Dim StartIndex As Long, EndIndex As Long, i As Long, lrow As Long
    Dim ws As Worksheet
    Dim lookupValue As Range, tableArray As Range, seriesOfRows As Range
    Dim intSheet As Integer, intArrayIndex As Integer
    Dim arSheets() As String
    Dim lcol As Long
    Dim rng As Range, rng1 As Range, cell1 As Range
    
    
    StartIndex = Sheets("Invoice").Index + 1
    EndIndex = Sheets.Count
    
    Set tableArray = Sheets("Client List").Range("A1:C93")
     
    intArrayIndex = 0


    For intSheet = StartIndex To EndIndex
        Set lookupValue = Sheets(intSheet).Range("A2")
        If Sheets(intSheet).Name <> "Sheet1" Then
            Sheets(intSheet).Rows(1).Insert
            Sheets(intSheet).Rows(1).Range("D1") = Application.WorksheetFunction.VLookup(lookupValue, tableArray, 2, False)
            LastMonth = Format(DateSerial(Year(Date), Month(Date) - 1, 1), "mm-yyyy")
            Sheets(intSheet).Columns("A").Delete
            
                        
                       
            Sheets(intSheet).Rows(1).Delete
            
            With Sheets(intSheet)
                lrow = .Range("A" & .Rows.Count).End(xlUp).Row
                lcol = Cells(1, .Columns.Count).End(xlToLeft).Column
                Set seriesOfRows = .Range(.Cells(1, 1), .Cells(lrow, 1))
                Set rng1 = Range(.Cells(1, 1), .Cells(lrow, 1))
                For Each cell1 In rng1
                    Set rng = .Range(.Cells(cell1.Row, 1), .Cells(cell1.Row, lcol))
                    With rng
                        With .Borders(xlEdgeBottom)
                            .LineStyle = xlContinuous
                            .Weight = xlThin
                            .ColorIndex = xlAutomatic
                        End With
                    End With
                Next cell1
                
                With rng
                    With .Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                End With
                Set rng = .Range(.Cells(1, 1), .Cells(1, lcol))
                   rng.Borders(xlEdgeBottom).LineStyle = xlContinuous
                   rng.Font.Bold = True
                   rng.Borders.LineStyle = xlDouble
            End With
            
            ReDim Preserve arSheets(intArrayIndex)
            arSheets(intArrayIndex) = Sheets(intSheet).Name
            intArrayIndex = intArrayIndex + 1
        End If
    Next


   ' Sheets(arSheets).Select
End Sub

rich
 
Upvote 0
RCBricker said:
see if this fixes it.

Code: 
Private Sub CommandButton4_Click()
    Dim StartIndex As Long, EndIndex As Long, i As Long, lrow As Long
    Dim ws As Worksheet
    Dim lookupValue As Range, tableArray As Range, seriesOfRows As Range
    Dim intSheet As Integer, intArrayIndex As Integer
    Dim arSheets() As String
    Dim lcol As Long
    Dim rng As Range, rng1 As Range, cell1 As Range
    
    
    StartIndex = Sheets("Invoice").Index + 1
    EndIndex = Sheets.Count
    
    Set tableArray = Sheets("Client List").Range("A1:C93")
     
    intArrayIndex = 0


    For intSheet = StartIndex To EndIndex
        Set lookupValue = Sheets(intSheet).Range("A2")
        If Sheets(intSheet).Name <> "Sheet1" Then
            Sheets(intSheet).Rows(1).Insert
            Sheets(intSheet).Rows(1).Range("D1") = Application.WorksheetFunction.VLookup(lookupValue, tableArray, 2, False)
            LastMonth = Format(DateSerial(Year(Date), Month(Date) - 1, 1), "mm-yyyy")
            Sheets(intSheet).Columns("A").Delete
            
                        
                       
            Sheets(intSheet).Rows(1).Delete
            
            With Sheets(intSheet)
                lrow = .Range("A" & .Rows.Count).End(xlUp).Row
                lcol = Cells(1, .Columns.Count).End(xlToLeft).Column
                Set seriesOfRows = .Range(.Cells(1, 1), .Cells(lrow, 1))
                Set rng1 = Range(.Cells(1, 1), .Cells(lrow, 1))
                For Each cell1 In rng1
                    Set rng = .Range(.Cells(cell1.Row, 1), .Cells(cell1.Row, lcol))
                    With rng
                        With .Borders(xlEdgeBottom)
                            .LineStyle = xlContinuous
                            .Weight = xlThin
                            .ColorIndex = xlAutomatic
                        End With
                    End With
                Next cell1
                
                With rng
                    With .Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                End With
                Set rng = .Range(.Cells(1, 1), .Cells(1, lcol))
                   rng.Borders(xlEdgeBottom).LineStyle = xlContinuous
                   rng.Font.Bold = True
                   rng.Borders.LineStyle = xlDouble
            End With
            
            ReDim Preserve arSheets(intArrayIndex)
            arSheets(intArrayIndex) = Sheets(intSheet).Name
            intArrayIndex = intArrayIndex + 1
        End If
    Next


   ' Sheets(arSheets).Select
End Sub

rich
Click to expand...

Something else is wrong. Even if I comment out that entire part and then manually highlight a range and try to add a bottom border, only the last row in the range gets the border. Here is what I have:
Code: 
Private Sub CommandButton4_Click()    Dim StartIndex As Long, EndIndex As Long, i As Long
    Dim ws As Worksheet
    Dim lookupValue As Range, tableArray As Range, seriesOfRows As Range
    Dim intSheet As Integer, intArrayIndex As Integer
    Dim arSheets() As String
    Dim lcol As Long, lrow As Long
    Dim rng As Range, rng1 As Range, cell1 As Range
    
    StartIndex = Sheets("Invoice").Index + 1
    EndIndex = Sheets.Count
    
    Set tableArray = Sheets("Client List").Range("A1:C93")
     
    intArrayIndex = 0


    For intSheet = StartIndex To EndIndex
        Set lookupValue = Sheets(intSheet).Range("A2")
        If Sheets(intSheet).Name <> "Sheet1" Then
            Sheets(intSheet).Rows(1).Insert
            Sheets(intSheet).Rows(1).Range("D1") = Application.WorksheetFunction.VLookup(lookupValue, tableArray, 2, False)
            LastMonth = Format(DateSerial(Year(Date), Month(Date) - 1, 1), "mm-yyyy")
            Sheets(intSheet).Columns("A").Delete
            
            With Sheets(intSheet).PageSetup.LeftHeaderPicture
                .filename = "S:\Billing\Client billing\LogoDoNotTouch\cpc_302X181.jpg"
                .Height = 70
                .Width = 120
                .Brightness = 0.36
                .ColorType = msoPictureAutomatic
                .Contrast = 0.59
                .CropBottom = 0
                .CropLeft = 0
                .CropRight = 0
                .CropTop = 0
            End With
            
            With Sheets(intSheet).PageSetup
                .LeftHeader = "&G"
                .CenterHeader = Sheets(intSheet).Range("C1")
                .RightHeader = "Invoice Detail for " & LastMonth
                .RightFooter = "Page &P of &N"
                .LeftFooter = "Printed on &D"
                .LeftMargin = Application.InchesToPoints(0.5)
                .RightMargin = Application.InchesToPoints(0.5)
                .TopMargin = Application.InchesToPoints(1.5)
                .BottomMargin = Application.InchesToPoints(1)
                .HeaderMargin = Application.InchesToPoints(0.5)
                .FooterMargin = Application.InchesToPoints(0.5)
            End With
            
            With Sheets(intSheet)
                .Range("A2").Value = "Physician"
                .Range("B2").Value = "Accession Number"
                .Range("C2").Value = "Patient Name"
                .Range("D2").Value = "Collection Date"
                .Range("E2").Value = "Procedure (CPT)"
                .Range("F2").Value = "Amount"
                .Columns("D:F").HorizontalAlignment = xlCenter
                .Columns("B").ColumnWidth = 15.67
                .Columns("A").ColumnWidth = 20.22
            End With
            
            Sheets(intSheet).Rows(1).Delete
            
 '           With Sheets(intSheet)
 '               Set cell1 = .Range(.Cells(1, 1), .Cells(1, 1))
 '               lrow = .Range("A" & .Rows.Count).End(xlUp).Row
 '               lcol = Cells(1, .Columns.Count).End(xlToLeft).Column
 '              ' Set seriesOfRows = .Range(.Cells(1, 1), .Cells(lrow, 1))
 '              Set rng1 = .Range(.Cells(cell1.Row, 1), .Cells(cell1.Row, lcol))
 '              For Each cell1 In rng1
 '                   Set rng = .Range(.Cells(1, 1), .Cells(lrow, lcol))
 '                   With rng
 '                       With .Borders(xlEdgeBottom).LineStyle = xlContinuous
 '                       ' .Weight = xlThin
 '                       '.ColorIndex = xlAutomatic
 '                       End With
 '                   End With
 '                   Next cell1
 '
 '               Set rng = .Range(.Cells(1, 1), .Cells(1, lcol))
 '                  rng.Borders(xlEdgeBottom).LineStyle = xlContinuous
 '                  rng.Font.Bold = True
 '                  rng.Borders.LineStyle = xlDouble
 '           End With
 '
            ReDim Preserve arSheets(intArrayIndex)
            arSheets(intArrayIndex) = Sheets(intSheet).Name
            intArrayIndex = intArrayIndex + 1
        End If
    Next


   ' Sheets(arSheets).Select
End Sub
 
Upvote 0
if you highlight a range and select bottom border, only the last row will get a bottom border. that is why I placed that set of commands with in a loop.

Are you trying to place top, bottom and left and right borders? ie each line of the range will have a continuous line on top, the bottom BUT only the left most cell will have a left border and only the right most cell will have a right border?

or

do you want each cell to be encapsulated in borders?

Rich
 
Upvote 0
Hi Rich,

I am sorry about this dragging on, but thanks for helping me. Yesterday the code was not working for me, but today it does (every row has just a bottom border, which is exactly what I want). Sometimes just taking a break helps :).

The only thing left now is that I do not want side borders on the top row and the borders are extending one column too far on the right.

Tracy
 
Upvote 0
Tracy,

check your LCOL variable value (in your immediate window type ?lcol) then check and see what column your header stops on. if your count the headers left to right you should get the same value as your LCOL variable. if not then the line for LCOL needs to be assigned to that row number so that it finds the correct last column for the header.

As for the left and right borders, I am not seeing anywhere in the code that those are set. is this all your code?

you can add these two lines to the code portion that sets the double lines for rng.

Code: 
    rng.Borders(xlEdgeLeft).LineStyle = xlNone
    rng.Borders(xlEdgeTop).LineStyle = xlNone

rich
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Solved
Still no solution after 1 Year - Please Help
2
Replies
10
Views
351
jolivanes
jolivanes
S
  • Question
Excel macros extremely slow
Replies
4
Views
176
Shloime
S
P
  • Question
Rationalise Code
Replies
1
Views
167
mumps
mumps
L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
322
RoryA
RoryA
togenmoser
  • Solved
Help with VBA code error "For variable already in use"
2 3
Replies
22
Views
314
MARK858
MARK858

Forum statistics

Threads
1,214,653
Messages
6,120,751
Members
448,989
Latest member
mariah3

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top