Underline all rows in a dynamic worksheet

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
 

Some videos you may like

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

RCBricker

Well-known Member
Joined
Feb 4, 2003
Messages
1,560
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
 

tharnden

New Member
Joined
Sep 2, 2015
Messages
16
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.
 

RCBricker

Well-known Member
Joined
Feb 4, 2003
Messages
1,560
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
 

tharnden

New Member
Joined
Sep 2, 2015
Messages
16

ADVERTISEMENT

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

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
 

RCBricker

Well-known Member
Joined
Feb 4, 2003
Messages
1,560
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
 

tharnden

New Member
Joined
Sep 2, 2015
Messages
16

ADVERTISEMENT

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

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
 

RCBricker

Well-known Member
Joined
Feb 4, 2003
Messages
1,560
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
 

tharnden

New Member
Joined
Sep 2, 2015
Messages
16
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
 

RCBricker

Well-known Member
Joined
Feb 4, 2003
Messages
1,560
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
 

Watch MrExcel Video

Forum statistics

Threads
1,114,513
Messages
5,548,496
Members
410,840
Latest member
Kar3ousse
Top