returning date and username if statement is true

lager28

New Member
Joined
Jul 30, 2019
Messages
9
I have an excel sheet that tracks documents that have been reviewed by project managers. When a PM reviews a document they select "Yes" from a drop down (only way i could figure out to limit data entry). What I am looking to do now is two seperate actions.
1. If "Yes" is in Cell D23 (the whole range is D23:D114 then I would like a current date entered into Cell E23 (whole range is E23:E114)
2. If "Yes" is in Cell D23 then I would like Excel to add the computer login (not the excel username) into Cell C23 (whole range is C23:C114)

I can get a date by using the following formula but it changes everytime the file is opened. I need the date to remain the same.

=IF(D25="Yes", NOW(),"")

I also managed to get a username to populate but I cannot find the forum where I got the instruction. What happens is that when I type =User in a cell it returns the username, so I've hidden "=USER" by making the text colour white in an empty cell where no input is likely to occur. However, it changes to the current system user each time the file is opened. I'd like it to remain the same after the first entry.

I'm new to VBA and still figuring out the power of formulas in excel so appreciate any and all help!
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,526
Office Version
  1. 365
Platform
  1. Windows
Hi & welcome to MrExcel.
How about
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("D23:D114")) Is Nothing Then
      If Target.Value = "Yes" Then
         Target.Offset(, 1).Value = Date
         Target.Offset(, -1).Value = Environ("username")
      End If
   End If
End Sub
Right click the tab you want this to work on, select "View code" & paste the above into the window that opens up.
The workbook will need to be saved as macro enabled.
 

lager28

New Member
Joined
Jul 30, 2019
Messages
9
Thanks Fluff! it works beautifully. Dare I ask... how would I now lock those Cells to be sure someone doesn't go in and change them?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,526
Office Version
  1. 365
Platform
  1. Windows
Make sure that C23:E114 are unlocked & use this
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("D23:D114")) Is Nothing Then
      If Target.Value = "Yes" Then
         Target.Offset(, 1).Value = Date
         Target.Offset(, -1).Value = Environ("username")
         Target.Offset(, -1).Resize(, 3).Locked = True
      End If
   End If
   Me.Protect "[COLOR=#ff0000]Pword[/COLOR]"
End Sub
change value in red to suit
 

lager28

New Member
Joined
Jul 30, 2019
Messages
9

ADVERTISEMENT

Thanks again, I've replaced my earlier code with the new set of instructions you suggest above. I get a "Run-Time Error '1004' Application-defined or object-defined error".

When I run the debugger it highlights the following line of code.

Target.Offset(, -1).Value = Environ("username")
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,526
Office Version
  1. 365
Platform
  1. Windows
The error sounds a bit odd if it worked before, but check that columns C, D, & E are unlocked for rows 23 to 114
 

lager28

New Member
Joined
Jul 30, 2019
Messages
9

ADVERTISEMENT

I checked to ensure C23-E114 were unlocked and tried again. I was able to change the contents of cells that had already received data, which is what I was hoping to avoid. I got the same error except this time the debugger highlighted this row.

Target.Offset(, -1).Resize(, 3).Locked = True

and said "Run-time error '1004': Unable to set the Locked property of the Range class? Any idea what I'm doing wrong?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,526
Office Version
  1. 365
Platform
  1. Windows
Try adding the line in blue
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("D23:D114")) Is Nothing Then
      If Target.Value = "Yes" Then
         [COLOR=#0000ff]Me.Unprotect "Pword"[/COLOR]
         Target.Offset(, 1).Value = Date
         Target.Offset(, -1).Value = Environ("username")
         Target.Offset(, -1).Resize(, 3).Locked = True
      End If
   End If
   Me.Protect "Pword"
End Sub
 

lager28

New Member
Joined
Jul 30, 2019
Messages
9
Thanks Fluff, unfortunately it didn't work. I have been pasting this into the VBA window that has other code in it - could something be conflicting with it?

Here is what is in the window.
Private Sub CheckBox1_Click()
[21:39].EntireRow.Hidden = Not CheckBox1
End Sub


Private Sub CheckBox2_Click()
[40:58].EntireRow.Hidden = Not CheckBox2
End Sub


Private Sub CheckBox3_Click()
[59:77].EntireRow.Hidden = Not CheckBox3
End Sub


Private Sub CheckBox4_Click()
[78:96].EntireRow.Hidden = Not CheckBox4
End Sub


Private Sub CheckBox5_Click()
[97:115].EntireRow.Hidden = Not CheckBox5
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("D23:D114")) Is Nothing Then
If Target.Value = "Yes" Then
Me.Unprotect "Pword"
Target.Offset(, 1).Value = Date
Target.Offset(, -1).Value = Environ("username")
Target.Offset(, -1).Resize(, 3).Locked = True
End If
End If
Me.Protect "Pword"
End Sub
 

lager28

New Member
Joined
Jul 30, 2019
Messages
9
Hi Fluff, something interesting happened when I changed the code back to the original. I did not unprotect the worksheet and even though it worked flawlessly without the .Locked line before, this time it returned that same error. When I unprotected the sheet it worked as it had before the .Locked line...
 

Watch MrExcel Video

Forum statistics

Threads
1,129,475
Messages
5,636,546
Members
416,923
Latest member
jarri

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top