Macros help

[Hopey87]

Hi,

I am trying to make a spreadsheet that will not only lock certain cells but when a button is clicked a new row is added and the previous row then becomes locked.

I want to lock all cells that are grey. Then once the click here button is pressed a new row is added to row 10 then row 11 becomes locked

 

[Cubist]

Try this on a copy. Assign the macro to your button.

This macro will lock all rows below 10.

Sub InsertAndLockRow()
    Dim ws As Worksheet
    Dim newRow As Range
    Dim oldRow As Range

    Set ws = ActiveSheet
    ws.Rows(10).Insert Shift:=xlDown
    Set newRow = ws.Rows(10)
    Set oldRow = ws.Rows(11)

    oldRow.Locked = True
    oldRow.FormulaHidden = True

    ws.Protect UserInterfaceOnly:=True, AllowFormattingCells:=True
    newRow.Locked = False
    newRow.Select
End Sub

 

[Hopey87]

Try this on a copy. Assign the macro to your button.

This macro will lock all rows below 10.

Sub InsertAndLockRow()
    Dim ws As Worksheet
    Dim newRow As Range
    Dim oldRow As Range

    Set ws = ActiveSheet
    ws.Rows(10).Insert Shift:=xlDown
    Set newRow = ws.Rows(10)
    Set oldRow = ws.Rows(11)

    oldRow.Locked = True
    oldRow.FormulaHidden = True

    ws.Protect UserInterfaceOnly:=True, AllowFormattingCells:=True
    newRow.Locked = False
    newRow.Select
End Sub

Thank You So much that helped

 

[Hopey87]

Try this on a copy. Assign the macro to your button. This macro will lock all rows below 10.

 Sub InsertAndLockRow() Dim ws As Worksheet Dim newRow As Range Dim oldRow As Range Set ws = ActiveSheet ws.Rows(10).Insert Shift:=xlDown Set newRow = ws.Rows(10) Set oldRow = ws.Rows(11) oldRow.Locked = True oldRow.FormulaHidden = True ws.Protect UserInterfaceOnly:=True, AllowFormattingCells:=True newRow.Locked = False newRow.Select End Sub

Try this on a copy. Assign the macro to your button.

This macro will lock all rows below 10.

Sub InsertAndLockRow()
    Dim ws As Worksheet
    Dim newRow As Range
    Dim oldRow As Range

    Set ws = ActiveSheet
    ws.Rows(10).Insert Shift:=xlDown
    Set newRow = ws.Rows(10)
    Set oldRow = ws.Rows(11)

    oldRow.Locked = True
    oldRow.FormulaHidden = True

    ws.Protect UserInterfaceOnly:=True, AllowFormattingCells:=True
    newRow.Locked = False
    newRow.Select
End Sub

Ok now i have a new issue i tried to add the top macro with another and it works but when i close out of it an reopen. It says this error.

my macro

Sub InsertAndLockRow()
    Dim ws As Worksheet
    Dim newRow As Range
    Dim oldRow As Range

    Set ws = ActiveSheet
    ws.Rows(10).Insert Shift:=xlDown
    Set newRow = ws.Rows(10)
    Set oldRow = ws.Rows(11)

    oldRow.Locked = True
    oldRow.FormulaHidden = True

    ws.Protect UserInterfaceOnly:=True, AllowFormattingCells:=True
    newRow.Locked = False
    newRow.Select
   
        ActiveSheet.Unprotect
    Range("A10:E10").Select
    Selection.Font.Bold = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("C10:E10").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Rows("10:10").RowHeight = 105
    Range("A10").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True
End Sub

 

[Michael M]

Maybe this ...UNTESTED

Sub InsertAndLockRow()
Dim ws As Worksheet
Dim newRow As Range
Dim oldRow As Range
ActiveSheet.Unprotect

Set ws = ActiveSheet
ws.Rows(10).Insert Shift:=xlDown
Set newRow = ws.Rows(10)
Set oldRow = ws.Rows(11)
oldRow.Locked = True
oldRow.FormulaHidden = True
newRow.Locked = False
Range("A10:E10").Font.Bold = False
    With Range("A10:E10").Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Range("A10:E10").Interior
        .Pattern = xlNone
    End With
    With Range("C10:E10")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .ReadingOrder = xlContext
    End With
Range("C10:E10").Merge
Rows("10:10").RowHeight = 105
Range("A10").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True
End Sub

 

[Hopey87]

Maybe this ...UNTESTED

Sub InsertAndLockRow()
Dim ws As Worksheet
Dim newRow As Range
Dim oldRow As Range
ActiveSheet.Unprotect

Set ws = ActiveSheet
ws.Rows(10).Insert Shift:=xlDown
Set newRow = ws.Rows(10)
Set oldRow = ws.Rows(11)
oldRow.Locked = True
oldRow.FormulaHidden = True
newRow.Locked = False
Range("A10:E10").Font.Bold = False
    With Range("A10:E10").Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Range("A10:E10").Interior
        .Pattern = xlNone
    End With
    With Range("C10:E10")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .ReadingOrder = xlContext
    End With
Range("C10:E10").Merge
Rows("10:10").RowHeight = 105
Range("A10").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True
End Sub

That worked perfectly thank you so much

 

[Michael M]

Glad it worked

 

[Peter_SSs]

That worked perfectly thank you so much

The marked solution has been changed accordingly. In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers. No further action is required for this thread.

Also, when posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags to your code in post #4 for you this time.