Underline all rows in a dynamic worksheet

[tharnden]

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

 

[tharnden]

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.

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

rich

Hi Rich,
The borders are just the way I want them now as far as getting rid of the inside horizontals, thanks (since I did not know they were called that, I could not tell you accurately what I was trying to do). I do not know how to use the immediate window. I tried, but was not successful. The borders are all extending one extra column though on all sheets.
Thanks,
Tracy

 

[RCBricker]

Ok do me a favor and post the code again. I will look at it first thing in the morning.

Rich

 

[tharnden]

Ok do me a favor and post the code again. I will look at it first thing in the morning.

Rich

I JUST got it to work! Since the last column is always "F", I specified it that way instead of finding it with the code. Here is what I have:

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
    
    With Application
        .ScreenUpdating = False
        lngCalc = .Calculation
        .Calculation = xlManual
        .EnableEvents = False
        .EnableCancelKey = xlErrorHandler
    End With
    
    StartIndex = Sheets("Invoice").Index + 1
    EndIndex = Sheets.Count
    
    Set tableArray = Sheets("Client List").Range("A1:C200")
     
    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.4)
                .RightMargin = Application.InchesToPoints(0.3)
                .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)
                lrow = .Range("A" & .Rows.Count).End(xlUp).Row
                lcol = Cells(1, 6).Column
                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 = xlDouble
                   rng.Font.Bold = True
                   rng.Borders(xlEdgeLeft).LineStyle = xlNone
                   rng.Borders(xlEdgeRight).LineStyle = xlNone
                   rng.Borders(xlInsideHorizontal).LineStyle = xlNone
               .Range("F" & lrow + 1).Value = Application.WorksheetFunction.Sum(.Range("F2:F" & lrow))
               .Columns("F").Style = "Currency"
             End With
            
            ReDim Preserve arSheets(intArrayIndex)
            arSheets(intArrayIndex) = Sheets(intSheet).Name
            intArrayIndex = intArrayIndex + 1
        End If
    Next
    With Application
        .ScreenUpdating = True
        .Calculation = lngCalc
        .EnableEvents = True
        .EnableCancelKey = xlInterrupt
    End With
End Sub

I don't know how I would have done this without your help, thanks a million!

Tracy

 

[RCBricker]

Glad I could help.

Just a note. If the columns always end in Column F, but the code was finding the last column as Column G...you should check to ensure you do not have any empty spaces or other recognizable nulls in column G. the easy way is to select cell I1 and hit the "End" button and then the right arrow. Then hit the "End" button and the left arrow. What column do you stop in?

its not a big deal since you now have everything working as you want it. However, little oddities like that make me twitch.
Just my 2 cps