Populate Date on Total Change

sscornav

Board Regular
Joined
Mar 20, 2010
Messages
125
I have the following spreadsheet. Users are allowed to update the yellow colored fields with their forecast. If the total changes (column E), I want to update column F with the current date/time and column G with the user name.

I could use some help with the macro. Thanks!

Excel Workbook
ABCDEFG
11Q2Q3Q4QTotalDate ChangedUser Name
210.0022.0035.0050.00117.00
315.0055.0020.0050.00140.00
475.0060.0040.0040.00215.00
545.0025.0025.0090.00185.00
Sheet1
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
sscornav,

You could use the Worksheet_Change Event for range A2:D5.


Sample data to begin with:


Excel Workbook
ABCDEFG
11Q2Q3Q4QTotalDate ChangedUser Name
20
30
40
50
6
Sheet1





As the user enters data into range A2:D5 you get this:


Excel Workbook
ABCDEFG
11Q2Q3Q4QTotalDate ChangedUser Name
21022355011705/24/2011 06:32:38 AMhiker95001
3151505/24/2011 06:32:49 AMhiker95001
40
50
6
Sheet1





Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Select the worksheet in which your code is to run
3. Right click on the sheet tab and choose View Code, to open the Visual Basic Editor
4. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
5. Press the keys ALT + Q to exit the Editor, and return to Excel


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
' hiker95, 05/24/2011
' http://www.mrexcel.com/forum/showthread.php?t=552211
If Intersect(Target, Range("A2:D5")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
With Application
  .EnableEvents = False
  .ScreenUpdating = False
  
  Range("F" & Target.Row) = Format(Now, "mm/dd/yyyy hh:mm:ss AM/PM")
  Range("G" & Target.Row) = Environ("username")
  
  .EnableEvents = True
  .ScreenUpdating = True
End With
End Sub


Then make entries to individual cells in range A2:D5
 
Upvote 0
This works great if someone types in the range A2:D5, but if they copy/paste numbers or "clear contents" it misses the update.

Is there any way to key in on the value of the field column E, then populate Column F&G ?
 
Upvote 0
Yes. What I've found is that if the contents of a cell changes, the even works. if the cell has a formula in it and the value changes, it does not. Is there a way around this?

So essentially, if the Total changes in column E, I would like to populate the User and Date in the respective columns.

I appreciate your help!
 
Upvote 0
sscornav,


Let's try the Worksheet_Calculate Event.


Sample worksheet Sheet1 before any data is entered/pasted into:


Excel Workbook
ABCDEFG
11Q2Q3Q4QTotalDate ChangedUser Name
20.00
30.00
40.00
50.00
6
Sheet1






After I paste in four rows of data:


Excel Workbook
ABCDEFG
11Q2Q3Q4QTotalDate ChangedUser Name
210.0022.0035.0050.00117.005/24/2011 9:02hiker95
315.0055.0020.0050.00140.005/24/2011 9:02hiker95
475.0060.0040.0040.00215.005/24/2011 9:02hiker95
545.0025.0025.0090.00185.005/24/2011 9:02hiker95
6
Sheet1





Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Select the worksheet in which your code is to run
3. Right click on the sheet tab and choose View Code, to open the Visual Basic Editor
4. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
5. Press the keys ALT + Q to exit the Editor, and return to Excel


Code:
Option Explicit
Private Sub Worksheet_Calculate()
' hiker95, 05/24/2011
' http://www.mrexcel.com/forum/showthread.php?t=552211
Dim c As Range
With Application
  .EnableEvents = False
  .ScreenUpdating = False
  For Each c In Me.Range("E2", Me.Range("E" & Rows.Count).End(xlUp))
    If c.Value <> 0 And c.Offset(, 1) = "" And c.Offset(, 2) = "" Then
      c.Offset(, 1) = Format(Now, "mm/dd/yyyy hh:mm:ss AM/PM")
      c.Offset(, 2) = Environ("username")
    End If
  Next c
  .EnableEvents = True
  .ScreenUpdating = True
End With
End Sub
 
Upvote 0
That doesn't seem to work either. If you clear out all the names and dates, go into the forecast for 1 row and update 1 number, all of the names and dates populate.

Can we key it off just the total value? If the total value changes for that row, we update the name and date, even if was populated.

Is there an event of dunction that detects if a value has changed?
 
Upvote 0
There is no way to trap a change of a cell that contains a formula. The Worksheet_Change event should trap deletion and copy/paste, but Hiker95's code worked only if a single cell was modified. Try this variation:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cell As Range
    If Intersect(Target, Range("A2:D5")) Is Nothing Then Exit Sub
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        For Each Cell In Target
            Range("F" & Cell.Row) = Format(Now, "mm/dd/yyyy hh:mm:ss AM/PM")
            Range("G" & Cell.Row) = Environ("username")
        Next Cell
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
 
Upvote 0
The workbook is protected. Where would be the most efficient place to unprotect the workbook in the code? Assuming a password of "pmo".

There is another macro that protects all but the yellow cells:

Private Sub Worksheet_Activate()
Const TEST_CI As Long = 36 'light yellow

With Me
.Unprotect "pmo"
.Cells.Locked = True

For Each Cell In .UsedRange
If Cell.Interior.ColorIndex = TEST_CI Then
Cell.Locked = False
End If
Next Cell

.Protect Password:="pmo", Scenarios:=True
End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,224,521
Messages
6,179,283
Members
452,902
Latest member
Knuddeluff

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
Back
Top