Adjustin code: fill color and border

[harveya915]

I have the following code to which I need help adjusting it to fit my needs. I need it for the fill in color to go from C3-G3 but as far down as there is data in column A. The same with the border from C3-G3 but as far down as there is data in column A.

If possible i would like to extend up to C2-G2, however those cells are merged together. Don't know if it would still be possible. IF it is great! if not, not a big deal.

Private Sub InsertNewWeek_Click()
    With Sheets("Sheet1")
        .Unprotect Password:="2019"
        .Range("C:H").EntireColumn.Insert
        .Range("C3:H3") = Array("End Week Total", "Used", "Restocked", "Price Per Item", "Purchase Total", "")
        .Range("C4").Formula = "=I4-D4+E4"
        .Range("C4", "C" & Cells(Rows.Count, 1).End(xlUp).Row).FillDown
        .Range("G4").Formula = "=E4*F4"
        .Range("G4", "G" & Cells(Rows.Count, 1).End(xlUp).Row).FillDown
        .Range("C:G").columnWidth = 12
        .Range("C:G").Interior.Color = RGB(221, 235, 247)
        .Range("F:G").NumberFormat = "$#,##0.00"
        .Range("C:G").WrapText = True
        .Range("C2:G2").MergeCells = True
        .Range("C2").Value = Date
        .Range("A1").Interior.ColorIndex = 3
        .Range("C:G").Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Range("C:G").Borders(xlEdgeRight).LineStyle = xlContinuous
        .Range("C:G").Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Range("C:G").Borders(xlEdgeTop).LineStyle = xlContinuous
        .Protect Password:="2019"
    End With
    Unload UserForm1
End Sub

Thanks!

 

[pike]

hello,
just use the row count

 With Sheets("Sheet1")
        .Unprotect Password:="2019"
        .Range("C:H").EntireColumn.Insert
        .Range("C3:H3") = Array("End Week Total", "Used", "Restocked", "Price Per Item", "Purchase Total", "")
        .Range("C4").Formula = "=I4-D4+E4"
        .Range("C4", "C" & Cells(Rows.Count, 1).End(xlUp).Row).FillDown
        .Range("G4").Formula = "=E4*F4"
        .Range("G4", "G" & Cells(Rows.Count, 1).End(xlUp).Row).FillDown
        .Range("C:G").ColumnWidth = 12
        .Range("F:G").NumberFormat = "$#,##0.00"
        .Range("C2:G2").MergeCells = True
        .Range("C2").Value = Date
        .Range("A1").Interior.ColorIndex = 3
        With .Range("C3:G" & Cells(Rows.Count, 1).End(xlUp).Row)
            .WrapText = True
            .Interior.Color = RGB(221, 235, 247)
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
        End With
        .Protect Password:="2019"
    End With

 

[harveya915]

The code portion for the border worked, however the fill in color goes on infinitely down and begins with row 1. I need it to begin with row 3 and finish with the last row in column A with data. Thanks!

 

[pike]

Hi ,
tested the code and its OK ,, maybe reset the worksheet to no colour and then rerun the sub

Sub InsertNewWeek_Click()
    With Sheets("Sheet1")
        .Unprotect Password:="2019"
        .Range("C:H").EntireColumn.Insert
        .Range("C3:H3") = Array("End Week Total", "Used", "Restocked", "Price Per Item", "Purchase Total", "")
        .Range("C4").Formula = "=I4-D4+E4"
        .Range("C4", "C" & Cells(Rows.Count, 1).End(xlUp).Row).FillDown
        .Range("G4").Formula = "=E4*F4"
        .Range("G4", "G" & Cells(Rows.Count, 1).End(xlUp).Row).FillDown
        .Range("C:G").ColumnWidth = 12
        .Range("F:G").NumberFormat = "$#,##0.00"
        .Range("C2:G2").MergeCells = True
        .Range("C2").Value = Date
        .Range("A1").Interior.ColorIndex = 3
        With .Range("C3:G" & Cells(Rows.Count, 1).End(xlUp).Row)
            .WrapText = True
            .Interior.Color = RGB(221, 235, 247)
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
        End With
        .Protect Password:="2019"
    End With
    Unload UserForm1
End Sub

 

[harveya915]

@pike Works perfect!
Thanks!