VBA auto insert value (date/name) based on another cells value

30 views Asked by At

First of all, I need to tell I have used a VBA shared by user 'Peh' in a topic from 2018.

link to shared VBA

I have used the following VBA, but the second part is not working, who can help me adjusting the second part (refering to the columns Q and P)? I also need a third part, refering to the columns W and V.

Private Sub Worksheet_Change(ByVal Target As Range)

    Const TimeColumn = "O"

    If Not Intersect(Target, Range("N7:N9999")) Is Nothing Then 'only trigger on column N

        Dim TargetRow As Range
        For Each TargetRow In Target.Rows 'needed if multiple rows are filled at once eg (copy/paste in col O)
            If Cells(TargetRow.Row, TimeColumn).Value = vbNullString Then 'test if there is already a date
                With Cells(TargetRow.Row, TimeColumn)
                    .Value = Now() 'write the value
                    .NumberFormat = "mm/dd/yyyy HH:mm" 'format it
                    .EntireColumn.AutoFit
                End With
            End If
        Next TargetRow

    End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    Const TimeColumn = "Q"

    If Not Intersect(Target, Range("P7:P9999")) Is Nothing Then 'only trigger on column P

        Dim TargetRow As Range
        For Each TargetRow In Target.Rows 'needed if multiple rows are filled at once eg (copy/paste in col Q)
            If Cells(TargetRow.Row, TimeColumn).Value = vbNullString Then 'test if there is already a date
                With Cells(TargetRow.Row, TimeColumn)
                    .Value = Now() 'write the value
                    .NumberFormat = "mm/dd/yyyy HH:mm" 'format it
                    .EntireColumn.AutoFit
                End With
            End If
        Next TargetRow

    End If

End Sub

The above VBA is to add a time stamp, but I also need to add a VBA where it will add a name (Application.UserName), how do I need to adjust the VBA for this?

Thanks in advance for the help.

What I try to reach: someone is requesting some paperwork, created by another company. A shared file is used (via Teams). We will add the time when we do the request (1st green column). Than someone from the other company will start working on it. By double click on the white square in front of it (used VBA to use cell as checkbox, see VBA below), when cell is checked, the next cell should show the user name working on it. The next check-cell is for the date/time he started with the paperwork. On the bottem you can see a print screen of the excel sheet I am talkin about, hope it is clear (enough).

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'Limit Target count to 1
    If Target.Count > 1 Then Exit Sub
    'Isolate Target to a specific range
    If Intersect(Target, Range("N7:N9999,P7:P9999,R7:R9999,T7:T9999,V7:V9999,X7:AW9999")) Is Nothing Then Exit Sub
    'set Target font tp "marlett"
    Target.Font.Name = "marlett"
    'Check value of target
    If Target.Value <> "a" Then
        Target.Value = "a" 'Sets target Value = "a"
        Cancel = True
        Exit Sub
    End If
    If Target.Value = "a" Then
        Target.ClearContents 'Sets Target Value = ""
        Cancel = True
        Exit Sub
    End If
End Sub

enter image description here

0

There are 0 answers