Consulting

Results 1 to 7 of 7

Thread: row protection based on specific cell

  1. #1
    VBAX Newbie
    Joined
    Aug 2023
    Posts
    5
    Location

    row protection based on specific cell

    How do I automatically protect a row based on a cell?
    Example: if you enter a value in cell E1, it will automatically protect cells to the left of the row, D1, C1, B1 and A1
    And the same would apply to the following lines, if you enter a value in cell E2 it will automatically protect the cells to the left and so on.

    Please help me.

  2. #2
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,059
    Location
    Maybe try this one
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Intersect(Target, Range("E:E")) Is Nothing Then Exit Sub
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect Password:="MyPassword"
        Range("A" & Target.Row & ":D" & Target.Row).Locked = True
        Application.ScreenUpdating = True
        ActiveSheet.Protect Password:="MyPassword" End Sub
    In this case simply change the password to the value you want to see in E1
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  3. #3
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,059
    Location
    oops.... Sorry Monteiro. Missed the important bit about each row.
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  4. #4
    VBAX Newbie
    Joined
    Aug 2023
    Posts
    5
    Location
    actually, I tested the command and it didn't work, but thanks for trying to help me

  5. #5
    VBAX Newbie
    Joined
    Aug 2023
    Posts
    5
    Location
    I would need something like this, that when inserting data in cell L413 it would automatically protect the cells to the left of the line, in this case cells A413:K413 and so on for the other lines... if you insert data in L414 it will automatically protect the line from A414: K414 and so onproteção.jpg

  6. #6
    VBAX Newbie
    Joined
    Aug 2023
    Posts
    5
    Location
    The only thing I managed to do was make a button to block it line by line, different from what I wanted, to make this process automatic...

    I tried to make the blocking automatic, but when I press ENTER, the cursor changes lines and the formula doesn't work, because it reads the current line from the cursor. An alternative I found was to create a button to trigger the command. First, the user has to position the cursor on the line of the record that he wants to confirm and, when he clicks on the button, the worksheet blocks the confirmed record line and changes the color of the cells to highlight the confirmed record. These commands also do not confirm registration until the inspector's name is informed ok.


    Sub Confirmar()
    If MsgBox("Deseja realmente confirmar e bloquear este registro", vbYesNo, "Confirmação") = vbYes Then
      Dim Lin As Integer
      Lin = ActiveCell.Row
      If Sheets("Planilha1").Cells(Lin, 4) <> "" Then
        Application.ScreenUpdating = False
        Sheets("Planilha1").Unprotect ("omiliso9001")
        Sheets("Planilha1").Select
        Sheets("Planilha1").Cells(Lin, 1).Locked = True
        Sheets("Planilha1").Cells(Lin, 2).Locked = True
        Sheets("Planilha1").Cells(Lin, 3).Locked = True
        Sheets("Planilha1").Cells(Lin, 4).Locked = True
        Sheets("Planilha1").Cells(Lin, 1).Interior.ColorIndex = 4
        Sheets("Planilha1").Cells(Lin, 2).Interior.ColorIndex = 4
        Sheets("Planilha1").Cells(Lin, 3).Interior.ColorIndex = 4
        Sheets("Planilha1").Cells(Lin, 4).Interior.ColorIndex = 4
        ActiveSheet.Protect ("omiliso9001")
      Else
        MsgBox "O registro somente pode ser confirmado quando informado o nome do inspetor!", vbInformation, "ERRO"
      End If
    End If
    Application.ScreenUpdating = True
    End Sub
    prot bot.jpg

  7. #7
    VBAX Newbie
    Joined
    Aug 2023
    Posts
    5
    Location
    I tried this code, I feel that I almost got what I wanted but it gives an error, I feel that there is little left

    Private Sub Worksheet_Change(ByVal Target As Range)    If Range("L:L") = "" Then
            Range("A3:K1048576").Locked = False
        ElseIf Range("L:L") = "inspector" Then
            Range("A3:K1048576").Locked = True
      Dim Lin As Integer
      Lin = ActiveCell.Row
      If Sheets("Planilha1").Cells(Lin, 12) <> "" Then
        Application.ScreenUpdating = False
        Sheets("Planilha1").Unprotect ("omiliso9001")
        Sheets("Planilha1").Select
        Sheets("Planilha1").Cells(Lin, 1).Locked = True
        Sheets("Planilha1").Cells(Lin, 2).Locked = True
        Sheets("Planilha1").Cells(Lin, 3).Locked = True
        Sheets("Planilha1").Cells(Lin, 4).Locked = True
        Sheets("Planilha1").Cells(Lin, 5).Locked = True
        Sheets("Planilha1").Cells(Lin, 6).Locked = True
        Sheets("Planilha1").Cells(Lin, 7).Locked = True
        Sheets("Planilha1").Cells(Lin, 8).Locked = True
        Sheets("Planilha1").Cells(Lin, 9).Locked = True
        Sheets("Planilha1").Cells(Lin, 10).Locked = True
        Sheets("Planilha1").Cells(Lin, 11).Locked = True
        Sheets("Planilha1").Cells(Lin, 12).Locked = True
        Sheets("Planilha1").Cells(Lin, 1).Interior.ColorIndex = 4
        Sheets("Planilha1").Cells(Lin, 2).Interior.ColorIndex = 4
        Sheets("Planilha1").Cells(Lin, 3).Interior.ColorIndex = 4
        Sheets("Planilha1").Cells(Lin, 4).Interior.ColorIndex = 4
        Sheets("Planilha1").Cells(Lin, 5).Interior.ColorIndex = 4
        Sheets("Planilha1").Cells(Lin, 6).Interior.ColorIndex = 4
        Sheets("Planilha1").Cells(Lin, 7).Interior.ColorIndex = 4
        Sheets("Planilha1").Cells(Lin, 8).Interior.ColorIndex = 4
        Sheets("Planilha1").Cells(Lin, 9).Interior.ColorIndex = 4
        Sheets("Planilha1").Cells(Lin, 10).Interior.ColorIndex = 4
        Sheets("Planilha1").Cells(Lin, 11).Interior.ColorIndex = 4
        Sheets("Planilha1").Cells(Lin, 12).Interior.ColorIndex = 4
        ActiveSheet.Protect ("omiliso9001")
      Else
    End If
      End If
    Application.ScreenUpdating = True
    End Sub

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •