Announcement

Collapse
No announcement yet.

Clearing contents in protected mode.

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Clearing contents in protected mode.



    Hi Team,

    I have below macro running fine in unprotected mode but contents does not clear's when the sheet is protected.

    Request you to please help in this regard.

    (Module)

    Option Explicit

    Sub UpdateLogWorksheet()

    Dim historyWks As Worksheet
    Dim inputWks As Worksheet

    Dim nextRow As Long
    Dim oCol As Long

    Dim myRng As Range
    Dim myCopy As String
    Dim myCell As Range

    'cells to copy from Input sheet - some contain formulas
    myCopy = "D5,D7,D9,D11,D13,F18,F19,F20,F21,F22,G18,G19,G20,G21,G22,H18,H19,H20,H21,H22,F28,F29,F30,F31,F32,F33,G28,G29,G30,G31,G32,G33,H28,H29,H30,H31,H32,H33,F39,F40,F41,G39,G40,G41,H39,H40,H41"

    Set inputWks = Worksheets("Input")
    Set historyWks = Worksheets("PartsData")

    With historyWks
    nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With

    With inputWks
    Set myRng = .Range(myCopy)

    If Application.CountA(myRng) <> myRng.Cells.Count Then
    MsgBox "Please fill in all the cells!"
    Exit Sub
    End If
    End With

    With historyWks
    With .Cells(nextRow, "A")
    .Value = Now
    .NumberFormat = "mm/dd/yyyy hh:mm:ss"
    End With
    .Cells(nextRow, "B").Value = Application.UserName
    oCol = 3
    For Each myCell In myRng.Cells
    historyWks.Cells(nextRow, oCol).Value = myCell.Value
    oCol = oCol + 1
    Next myCell
    End With

    'clear input cells that contain constants
    With inputWks
    On Error Resume Next
    With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
    .ClearContents
    Application.GoTo .Cells(1) ', Scroll:=True
    End With
    On Error GoTo 0
    End With
    End Sub

    Thanks

  • #2
    Hi,

    In order to clear contents in protected mode ...

    You need to follow these steps :

    1. Un - Protect

    2. Clear Contents

    3. Re - Protect

    Hope this will help

    If you feel like saying "Thank You" for the help received ...You can click on the "Like" icon ...just underneath ... ... in the bottom right corner ...

    Comment


    • #3


      Great Carim,

      It would be very nice of you if you could help with the code.

      Also please add for protect or unprotect code in which line in below script

      Hi Team,

      I have below macro running fine in unprotected mode but contents does not clear's when the sheet is protected.

      Request you to please help in this regard.

      (Module)

      Option Explicit

      Sub UpdateLogWorksheet()

      Dim historyWks As Worksheet
      Dim inputWks As Worksheet

      Dim nextRow As Long
      Dim oCol As Long

      Dim myRng As Range
      Dim myCopy As String
      Dim myCell As Range

      'cells to copy from Input sheet - some contain formulas
      myCopy = "D5,D7,D9,D11,D13,F18,F19,F20,F21,F22,G18,G19,G20,G21,G22,H18,H19,H20,H21,H22,F28,F29,F30,F31,F32,F33,G28,G29,G30,G31,G32,G33,H28,H29,H30,H31,H32,H33,F39,F40,F41,G39,G40,G41,H39,H40,H41"

      Set inputWks = Worksheets("Input")
      Set historyWks = Worksheets("PartsData")

      With historyWks
      nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
      End With

      With inputWks
      Set myRng = .Range(myCopy)

      If Application.CountA(myRng) <> myRng.Cells.Count Then
      MsgBox "Please fill in all the cells!"
      Exit Sub
      End If
      End With

      With historyWks
      With .Cells(nextRow, "A")
      .Value = Now
      .NumberFormat = "mm/dd/yyyy hh:mm:ss"
      End With
      .Cells(nextRow, "B").Value = Application.UserName
      oCol = 3
      For Each myCell In myRng.Cells
      historyWks.Cells(nextRow, oCol).Value = myCell.Value
      oCol = oCol + 1
      Next myCell
      End With

      'clear input cells that contain constants
      With inputWks
      On Error Resume Next
      With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
      .ClearContents
      Application.GoTo .Cells(1) ', Scroll:=True
      End With
      On Error GoTo 0
      End With
      End Sub

      Thanks

      Comment

      Working...
      X