Help with VBA Excel - lock cell after fill

Question

Hi, I’m trying to improve the control spreadsheet of the company I work for, but I’m having trouble.

We have to register a customer’s call, I have already been able to fill in the Date and Time sheet automatically after filling in the Name field. What I want now is to protect the Date and Time fields at this time, so it cannot be changed. What is happening is that in some rows excel has blocked the entire line. Can anyone help me?

That’s the code I made so far.

Private Sub Worksheet_Change(ByVal Alvo As Range)

     Dim limite_maximo As Integer

  limite_maximo = 4000 ' limite ultima linha

  If Alvo.Cells.Count > 1 Or IsEmpty(Alvo) Then Exit Sub

    ' faz nada se mais de uma célula modificada ou se deu delete

  If Alvo.Column = 5 And Alvo.Row >= 4 And Alvo.Row <= limite_maximo Then

    ' o if acima seta onde vai iniciar e o range e = 5 (coluna), row (linha = 4)

    ' desliga captura do evento change

  Application.EnableEvents = False

    ' muda a célula E da linha correspondente

  ' Desprotege

  ActiveSheet.Unprotect

  Alvo.Offset(0, -1).Value = Time() ' Registra a hora (A = 0, D = 3)
  Alvo.Offset(0, -2).Value = Date   ' Registra a data (A = 0, E = 4)

  Linha = Alvo.Row

  Range("C" & Linha).Locked = True
  Range("e" & Linha).Locked = True

  ' Protege
  ActiveSheet.Protect

  ' religa a captura de eventos
  Application.EnableEvents = True
  End If
End Sub

This is the spreadsheet

Answer 1

First you must enter Locked = False in all cells of the spreadsheet only once, with the following code:

Sub Destravar_Tudo()
    ActiveSheet.Unprotect
    ActiveSheet.Cells.Locked = False
End Sub

For by default in .Protect, all cells are with .locked = True

Then, when locking each cell, the spreadsheet is protected with ActiveSheet.Protect Contents:=True, DrawingObjects:=False, as can be seen in the code below:

Private Sub Worksheet_Change(ByVal Alvo As Range)
    Dim limite_maximo As Long, linha As Long
    'Tratar Erros
    On Error GoTo sair

    limite_maximo = 4000                         ' limite ultima linha

    If Alvo.Cells.Count > 1 Or IsEmpty(Alvo) Then Exit Sub

    ' faz nada se mais de uma célula modificada ou se deu delete
    If Alvo.Column = 5 And Alvo.Row >= 4 And Alvo.Row <= limite_maximo Then
        ' o if acima seta onde vai iniciar e o range e = 5 (coluna), row (linha = 4)
        ' desliga captura do evento change
        Application.EnableEvents = False

        ' muda a célula E da linha correspondente
        ' Desprotege

        ActiveSheet.Unprotect

        Alvo.Offset(0, -1).Value = Time()        ' Registra a hora (A = 0, D = 3)
        Alvo.Offset(0, -2).Value = Date          ' Registra a data (A = 0, E = 4)

        linha = Alvo.Row

        Range("C" & linha & ":E" & linha).Cells.Locked = True

        ' Protege
        ActiveSheet.Protect Contents:=True, DrawingObjects:=False
    End If
sair:
    ' religa a captura de eventos
    Application.EnableEvents = True
End Sub

Or to manually lock each line:

Sub manual_linha()
    Dim linha As Long
    linha = 4
    ActiveSheet.Unprotect
    Range("C" & linha & ":E" & linha).Cells.Locked = True
    ActiveSheet.Protect Contents:=True, DrawingObjects:=False
End Sub

In the example, line 4 is being used, hence the range of C4:E4