CommandButton1_automatically update the date in ("A") column

[Mawar5530]

Hi,

i have try to code as below, but seem not reflecting.

I want column A14 to a44, if any value in number for this column then the "B" will update the time.
Next will lock the cell that has the value and color yellow.

I need help on this.

Private Sub CommandButton1_Click()

If Range("A14:A44") Is Nothing Then

On Error Resume Next

If Target.Value = "" Then

Target.Offset(0, 1) = ""

Else

Target.Offset(0, 1).Value = Format("HH:mm:ss")


End If
End If

End Sub

[Paul_Hossler]

1. Range("A4:A14") always exists and hence will never be Nothing

2. Target is not defined so On Error Resume Next will just keep on going

3. Format("HH:mm:ss") doesn't have anything to format


I'm guessing that you wanted something like this (to at least get you started)



Option Explicit


Private Sub CommandButton1_Click()
Dim r As Range, r1 As Range

On Error Resume Next
Set r = Range("A4:A14").SpecialCells(xlCellTypeConstants, xlNumbers)
On Error GoTo 0

If r Is Nothing Then Exit Sub

For Each r1 In r.Cells
If Len(r1.Offset(0, 1).Value) = 0 Then
r1.Offset(0, 1).Value = Format(Now, "HH:mm:ss")
r1.Offset(0, 1).Locked = True
r1.Resize(1, 5).Interior.Color = 13434879
End If
Next


End Sub

[Mawar5530]

Hi Paul.

Yeah, thank you so much. Its run well.

However the locked is not functioning, can please help.
i try to do via the format cell , then the macro not working with the cell locked.

[Paul_Hossler]

All cells on the WS are Locked=False, except for B4:E14 which are Locked = True

More that that, you'll have to figure out the other specifics



Option Explicit




Private Sub CommandButton1_Click()
Dim r As Range, r1 As Range

On Error Resume Next
Set r = Range("A4:A14").SpecialCells(xlCellTypeConstants, xlNumbers)
On Error GoTo 0

If r Is Nothing Then Exit Sub

Me.Unprotect "abc"

For Each r1 In r.Cells
If Len(r1.Offset(0, 1).Value) = 0 Then
r1.Offset(0, 1).Value = Format(Now, "HH:mm:ss")
r1.Offset(0, 1).Locked = True
r1.Resize(1, 5).Interior.Color = 13434879
End If
Next


Me.Protect Password:="abc", UserInterfaceOnly:=True


End Sub