Unprotect_Run code_Protect sheet Excel VBA

[B_Siva]

Need Help...
I got runtime error 1004. Application defined or object defined error.
In excel sheet, Column H,I,J is locked and protected.
I want to capture the user name, date and week in column H,I,J when someone update the cell in column G.

below is the code. (It's work when sheet is not protected/remove the line ActiveSheet.Unprotect = "HullPU")



Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect = "HullPU"
If Target.Cells.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("G6:G3000")) Is Nothing Then 'change your range on this line"

If Target.Value = 30 Then
Target.Offset(0, 1).Value = UserName
Target.Offset(0, 2).Value = Date
Target.Offset(0, 3).Value = Mid(Year(Date), 3, 2) & "_" & ISOWeekNum(Date)
Else
Target.Offset(0, 2).Value = Target.Offset(0, 2).Value

End If
End If
ActiveSheet.Protect = "HullPU"
End Sub

 

[Davavo]

Need Help...
I got runtime error 1004. Application defined or object defined error.
In excel sheet, Column H,I,J is locked and protected.
I want to capture the user name, date and week in column H,I,J when someone update the cell in column G.

below is the code. (It's work when sheet is not protected/remove the line ActiveSheet.Unprotect = "HullPU")



Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect = "HullPU"
If Target.Cells.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("G6:G3000")) Is Nothing Then 'change your range on this line"

If Target.Value = 30 Then
Target.Offset(0, 1).Value = UserName
Target.Offset(0, 2).Value = Date
Target.Offset(0, 3).Value = Mid(Year(Date), 3, 2) & "_" & ISOWeekNum(Date)
Else
Target.Offset(0, 2).Value = Target.Offset(0, 2).Value

End If
End If
ActiveSheet.Protect = "HullPU"
End Sub

I think you need to write 'password'

e.g.

Sheets("sheetname").Select
    Sheets("sheetname").Unprotect Password:="[COLOR=#0000FF]HullPU[/COLOR]"
   
Your Code                                     

    Sheets("sheetname").Protect Password:="[COLOR=#0000FF]HullPU[/COLOR]"

 

[Fluff]

Just remove the = signs

Private Sub Worksheet_Change(ByVal Target As Range)
 ActiveSheet.Unprotect  "HullPU"
    If Target.Cells.Count > 1 Then Exit Sub

   If Not Intersect(Target, Range("G6:G3000")) Is Nothing Then  'change your range on this line"

        If Target.Value = 30 Then
            Target.Offset(0, 1).Value = UserName
            Target.Offset(0, 2).Value = Date
            Target.Offset(0, 3).Value = Mid(Year(Date), 3, 2) & "_" & ISOWeekNum(Date)
        Else
            Target.Offset(0, 2).Value = Target.Offset(0, 2).Value

    End If
    End If
    ActiveSheet.Protect  "HullPU"
End Sub

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Intersect(Target, Range("G6:G3000")) Is Nothing Then Exit Sub
    ActiveSheet.Unprotect Password:="HullPU"
    If Target.Value = 30 Then
        Target.Offset(0, 1) = Application.UserName
        Target.Offset(0, 2) = Date
        Target.Offset(0, 3) = Mid(Year(Date), 3, 2) & "_" & WorksheetFunction.WeekNum(Date)
    Else
        Target.Offset(0, 2).Value = Target.Offset(0, 2).Value
    End If
    ActiveSheet.Protect Password:="HullPU"
End Sub

 

[B_Siva]

Davavo,
Thanks.. but does not work.. Same error msg

 

[B_Siva]

Fluff,
Nope. It doesn't work... below code works when sheet is not protected..
It don't work when I insert code for unprotect and protect again.


Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub


If Not Intersect(Target, Range("G6:G3000")) Is Nothing Then 'change your range on this line"


If Target.Value = 30 Then
Target.Offset(0, 1).Value UserName
Target.Offset(0, 2).Value Date
Target.Offset(0, 3).Value Mid(Year(Date), 3, 2) & "_" & ISOWeekNum(Date)
Else
Target.Offset(0, 2).Value = Target.Offset(0, 2).Value


End If
End If

End Sub

 

[Fluff]

I very much doubt that code works at all, there are too many things wrong with it.
Try the code that mumps supplied, if that does not work please show what line is giving the error.

 

[B_Siva]

The code that works without sheet/column protected/locked
I have declare public function for ISOWeekNum, UserName before this subroute

Below code works well

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub


If Not Intersect(Target, Range("G6:G3000")) Is Nothing Then 'change your range on this line"


If Target.Value = 30 Then
Target.Offset(0, 1).Value = UserName
Target.Offset(0, 2).Value = Date
Target.Offset(0, 3).Value = Mid(Year(Date), 3, 2) & "_" & ISOWeekNum(Date)
Else
Target.Offset(0, 2).Value = Target.Offset(0, 2).Value


End If
End If

End Sub

result in excel sheet
[TABLE="width: 0"]
<tbody>[TR]
[TD]Cutting Status
[/TD]
[TD]Updated By
[/TD]
[TD]Cutting Plan Actual Cut Date
[/TD]
[TD]Cutting Plan Cut Week
[/TD]
[/TR]
[TR]
[TD]30
[/TD]
[TD]30000270
[/TD]
[TD]12-Aug-19
[/TD]
[TD]19_33
[/TD]
[/TR]
</tbody>[/TABLE]

 

[B_Siva]

Hi Mumps,
Thanks.. Resolved. It works.. Thank you..

 

[mumps]

Glad to help out.