is it possible to have some VBA to record the user for who ever last modified a specific cell? i.e., if someone opens the workbook and enters a value into A1, I'd like B1 to show the username of the person who did that, and then, if someone else opens the workbook and enters a value into A2, i'd like their user name in B2 and so on and so forth... I've playing around with examples like the below, but I'm not sure if I'm getting any closer, seems i can only grab the username for whoever last modified the workbook.
Function LastAuthor()
LastAuthor = ActiveWorkbook.BuiltinDocumentProperties("Last Author")
End Function
This inserts the windows user/network user in column B whenever one or more values are added/modified/deleted in column A.
Add this to the worksheet's private code sheet; not a public module code sheet.
private sub worksheet_change(byval target as range)
if not intersect(range("A:A"), target) is nothing then
on error goto meh
application.enableevents = false
dim t as range
for each t in intersect(range("A:A"), target)
t.offset(0, 1) = environ("user")
't.offset(0, 2) = now
next t
end if
meh:
application.enableevents = true
end sub
Related
I am new to excel VBA and I can't find my answer anywhere. In my Worksheet "Follow-Up Log" I would like cells with no text in the range A1:A70 to allow user edits (then automatically lock after the change) while those cells with text are password protected at all times. I would also like the range to use a different password than the worksheet and for the user to enter in the password anytime they wish to edit a cell with text in the range.
I am hoping to apply the same code to ranges B1:B70, K1:K70, but a different password for each range, all of which are different from the worksheet. Overall I intend to have 4 passwords for this single sheet.
The current code I'm using locks cells after the text has been entered but it's changing the Worksheet password instead of just the cells and you only enter the password once. Does this make sense? Here's the code I'm using:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim blnUnlockedAllCells As Boolean
Const RangeToLock As String = "A2:A70" '<< adjust to suit
If Target.Cells.Count > 1 Then Exit Sub
If Not blnUnlockedAllCells Then
Me.Cells.Locked = False
On Error Resume Next
Me.Range(CStr(RangeToLock)).SpecialCells(2).Locked = True
On Error GoTo 0
blnUnlockedAllCells = True
Me.Protect Password:="pwd", userinterfaceonly:=True
End If
If Not Application.Intersect(Target, Me.Range(CStr(RangeToLock))) Is Nothing Then
If Len(Target) Then Target.Locked = True
End If
You dont need to lock them. I just recorded this macro to figure out how to do it for multiple ranges:
With ActiveSheet
.Protection.AllowEditRanges.Add Title:="Range1", Range:=.Range("G8:J10"), Password:="qq"
.Protection.AllowEditRanges.Add Title:="Range2", Range:=.Range("K11:L12"), Password:="aa"
End With
But keep in mind that if the person knows how to open the code window, they will be easily able to see your passwords.
The code "setupranges" can set up the ranges and passwords to edit. This does all the work. Copy and paste both of the following subroutines into a new module (insert a module). Make sure you change the passwords to any you have already set.
Sub setupranges(wsname As String, rangeX As String)
Dim rangea, rangeb, rangek As String
Dim pwda, pwdb, pwdk As String
Dim Ws As Worksheet
Dim pwdws As String
Set Ws = Worksheets(wsname)
rangea = "A1:A70"
rangeb = "B1:B70"
rangek = "K1:K70"
pwda = "aaa"
pwdb = "bbb"
pwdk = "kkk"
pwdws = "pwd"
On Error Resume Next
Ws.Unprotect Password:=pwdws
On Error GoTo 0
Select Case rangeX
Case Is = "all"
Call deleterangeifexists(Ws, "a")
Ws.Protection.AllowEditRanges.Add Title:="arange",Range:=Ws.Range(rangea), Password:=pwda
Call deleterangeifexists(Ws, "b")
Ws.Protection.AllowEditRanges.Add Title:="brange", Range:=Ws.Range(rangeb), Password:=pwdb
Call deleterangeifexists(Ws, "k")
Ws.Protection.AllowEditRanges.Add Title:="krange", Range:=Ws.Range(rangek), Password:=pwdk
Case Is = "a"
Call deleterangeifexists(Ws, "arange")
Ws.Protection.AllowEditRanges.Add Title:="arange", Range:=Ws.Range(rangea), Password:=pwda
Case Is = "b"
Call deleterangeifexists(Ws, "brange")
Ws.Protection.AllowEditRanges.Add Title:="brange",Range:=Ws.Range(rangeb), Password:=pwdb
Case Is = "k"
Call deleterangeifexists(Ws, "krange")
Ws.Protection.AllowEditRanges.Add Title:="krange", Range:=Ws.Range(rangek), Password:=pwdk
End Select
Ws.Protect Password:=pwdws, userinterfaceonly:=True
End Sub
You'll get an error if the range already exists when you try to add it, so this deletes the defined range if it already exists.
Sub deleterangeifexists(Ws As Worksheet, Title As String)
Dim rangetocheck As AllowEditRange
For Each rangetocheck In Ws.Protection.AllowEditRanges
If rangetocheck.Title = Title Then
rangetocheck.Delete
Exit Sub
End If
Next
End Sub
Then you have to call setupranges from your worksheet e.g.
call setupranges("sheet1","all")
would reset all passwords for all ranges.
call setupranges("sheet1","arange")
would reset the password for the range in column A only.
I would suggest either worksheet_change or worksheet_selectionchange depending on how you want your workbook to behave.
With Worksheet_change bear in mind that your user might unlock a range, then not change anything so your routine wouldn't run and the range would remain unlocked. With Worksheet_selectionchange the code's going to run with every change of cell focus which might be slow. One of them gives you as Target the cell you're now in and one gives you the cell you came from and that might make it easier or harder for you.
Either way, your worksheet code will have:
If condition is true (whatever condition you want to measure) Then
call setupranges("sheet1","all")
End If
I have an Excel formula that gives me the last Friday's date "=TODAY()-WEEKDAY(TODAY())-1" in cell A1
I want to update cell A1 only when the values in reference range in another worksheet B2:D469 changes.
Below is the code i am using but the issue is code only works when i manually make a change in the range. However values in the range gets updated when source pivot table refresh. I want code to get updated when i refresh the pivot table and the values in the range "B2:D469" changes.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Worksheets.("Source").Range("B2:D469")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Worksheets.("Dashboard").Range ("A1").EnableCalculation = True
End If
End Sub
Range.Dependents
Range has a property Dependents which is a Range containing all cells that this Range affects, even if they are several steps removed. For example if C4 is "=B4" and B4 is "=A4", Range("A4").Dependents will include both B4 and C4.
So, in your case, if Target affects a cell you care about, it's included in the Range Target.Dependents. You can use this to accomplish your goal.
How to use it
Use the following as the code of ThisWorkbook. I've commented the heck out of it, but if you have questions feel free to ask in the comments.
Option Explicit
Private RangeToMonitor As Range
Private RangeToChange As Range
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'---If this is the first change since the workbook has been opened, define the ranges---
If RangeToMonitor Is Nothing Then
Set RangeToMonitor = Worksheets("Source").Range("B2:D469")
Set RangeToChange = Worksheets("Dashboard").Range("A1")
End If
'---------------------------------------------------------------------------------------
'First, check to see if Target is in the RangeToMonitor
If Not Application.Intersect(Target, RangeToMonitor) Is Nothing Then
'If so, set your date. Rather than using a formula in the cell - which could go haywire if someone messes with it - just set it straight from VBA
RangeToChange.Value = Date - Weekday(Date) - 1
'Second, check to see if a change to Target *triggers* any recalculation of cells in RangeToMonitor.
'You can do this by looking at Dependents, which is all the cells affected by a change to Target, even several steps removed
ElseIf hasDependents(Target) Then
'(The above and below criteria cannot be done in one if condition because VBA boolean operators do not short circuit)
If Not (Application.Intersect(Target.Dependents, RangeToMonitor) Is Nothing) Then
RangeToChange.Value = Date - Weekday(Date) - 1
End If
End If
End Sub
'The reason for this function is that trying to use Target.Dependents when Target has no Dependents causes an error
'I use this function to verify that Target DOES have Dependents before attempting to find out if any of them affects RangeToMonitor
Private Function hasDependents(rng As Range)
On Error GoTo ErrHandler
Dim test As Long
test = rng.DirectDependents
hasDependents = True
Exit Function
ErrHandler:
If Err.Number = 1004 Then
'"No Cells Were Found"
'This error signifies that Target has no Dependents, so we can safely ignore the change and exit the event.
hasDependents = False
Else
Err.Raise Err.Number, , Err.Description
End If
End Function
I have tried code that I've found here on stackoverflow, and elsewhere but they aren't working as I think they can. I'll list them below. I'm almost certain this is an easy question.
What I'm trying to do: If in any of the cells in the range A2:A100 there is any text or number whatsoever, then make the worksheet tab red. And I will need to do this on over 20 tabs. This must execute upon opening the workbook, and thus not require manually changing a cell or recalculating.
The problems I've had with other code: As far as I can tell they require editing a cell, and then quickly hitting enter again. I tried SHIFT + F9 to recalculate, but this had no effect, as I think this is only for formulas. Code 1 seems to work albeit with having to manually re-enter text, but no matter what color value, I always get a black tab color.
Code I've tried:
Code 1:
Private Sub Worksheet_Change(ByVal Target As Range)
MyVal = Range("A2:A27").Text
With ActiveSheet.Tab
Select Case MyVal
Case ""
.Color = xlColorIndexNone
Case Else
.ColorIndex = 6
End Select
End With
End Sub
Code 2: This is from a stackoverflow question, although I modified the code slightly to fit my needs. Specifically, if in the set range there are no values to leave the tab color alone, and otherwise to change it to color value 6. But I'm sure I've done something wrong, I'm unfamiliar with VBA coding.
Private Sub Worksheet_Calculate()
If Range("A2:A100").Text = "" Then
ActiveWorkbook.ActiveSheet.Tab.Color = xlColorIndexNone
Else
ActiveWorkbook.ActiveSheet.Tab.Color = 6
End If
End Sub
Thanks for your help!
I posted this on superuser first, but perhaps stackoverflow is more appropriate since it is explicitly programming-related.
Only two things will be able to switch the condition in this statement:
If Range("A2:A100").Text = "" Then
You've already identified both of them, changing the contents of the one of the cells in that range on a worksheet, or a formula in one of those cells recalculating to or from a value of "". As far as event triggers go, if the formula result changes, both the WorkSheet_Calculate and Worksheet_Change events will fire. Of the two, Worksheet_Change is the one to respond to, because WorkSheet_Calculate will only fire if any of the cells in A2:A100 contain a formula. Not if they only contain values - your "Code 2" isn't wrong, the event was just never firing.
The simple solution is to set your tab colors when you open the workbook. That way it doesn't matter if you have to activate a cell in that range and change it - that's only way the value you're testing against is going to change.
I'd do something like this (code in ThisWorkbook):
Option Explicit
Private Sub Workbook_Open()
Dim sheet As Worksheet
For Each sheet In Me.Worksheets
SetTabColor sheet
Next sheet
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Sh.Range("A2:A100")) Is Nothing Then
SetTabColor Sh
End If
End Sub
Private Sub SetTabColor(sheet As Worksheet)
If sheet.Range("A2:A100").Text = vbNullString Then
sheet.Tab.Color = xlColorIndexNone
Else
sheet.Tab.Color = 6
End If
End Sub
EDIT: To test for the presence of specific text, you can do the same thing but need to have the test check every cell in the range you're monitoring.
Private Sub SetTabColor(sheet As Worksheet)
Dim test As Range
For Each test In sheet.Range("A2:A100")
sheet.Tab.Color = xlColorIndexNone
If test.Text = "whatever" Then
sheet.Tab.Color = vbRed
Exit For
End If
Next test
End Sub
Maybe test the len of the trimmed joined string of cells:
Private Sub Worksheet_Calculate()
If Len(Trim(Join(Application.Transpose(Range("A2:A100"))))) = 0 Then
ActiveWorkbook.ActiveSheet.Tab.Color = xlColorIndexNone
Else
ActiveWorkbook.ActiveSheet.Tab.Color = 6
End If
End Sub
This code will fire off every time the sheet calculates though as it is event code, I am not sure if that is what you want? If not then post back and we can drop it into a normal sub for you and make it poll all the sheets to test.
Worksheet_Change function will get called everytime there's change in the target range. You just need to place the code under Worksheet. If you have placed the code in the module or Thisworkbook then it wont work.
Paste the below in Sheet1 of your workbook and check if it works. Of Course you will need to do modification to the below code as I have not written complete code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WatchRange As Range
Dim IntersectRange As Range
Set WatchRange = Range("A1:A20")
Set IntersectRange = Intersect(Target, WatchRange)
If IntersectRange Is Nothing Then
''Here undo tab color
Else
ActiveSheet.Tab.ColorIndex = 6
End If
End Sub
I would like my Macro to launch whenever a value in a cell containing a formula changes.
i.e. the user is modifying another cell thus changing the value of the cell in question.
I have noticed that using the statement (found herein), only works if the user modifies the cell itself but not if the cell changes automatically - due to a formula as specified above.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A20")) Is Nothing Then ...
Any thoughts??
I tried to follow the answers from this question "automatically execute an Excel macro on a cell change" but it did not work...
Thanks in advance :)
A possible work-around comes from the fact that, to change a value, the user needs to change the selection first. So I would:
1) Declare a global variable called "oldValue" on top of the WS source code module:
Dim oldValue As Variant
2) Register the old value of your formula before the user types anything (let's say it's in Range("A4"), I let you adapt with the others):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
oldValue = Range("A4")
End Sub
3) Check if the change has affected the formula in the Change event:
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A4") <> oldValue Then
MsgBox "User action has affected your formula"
End If
End Sub
I've tested with a simple sum, I'm able to write cells that are not involved without any prompt but if I touch one of the cells involved in the sum the MsgBox will show up. I let you adapt for multiple cases, for user adding/removing rows (in that case I suggest to name the ranges containing the formulas you want to track) and the worksheet references.
EDIT I'd like to do it at once, not by going through 2 processes, is it possible? The problem is my macro involves a range containing more than one cell so it will be hard to store old values for 10 cells.
If ranges are next to each other, then instead of using a variable you can use a collection:
Dim oldValues As New Collection
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For j = 1 To 10
oldValues.Add Range("A" & j).Value
Next j
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
For j = 1 To 10
If Range("A" & j).Value <> oldValues(j) Then
MsgBox "The value of Range(A" & j & ") has changed"
End If
Next j
End Sub
Of course, if ranges are not close to each other, you can just store them anyway in the SelectionChange event like this:
oldValues.Add Range("A1").Value
oldValues.Add Range("B7").Value
'...
and if you done this ONCE, with 10 ranges only, it should be a reasonable solution to your problem.
You said, "I would like my Macro to launch whenever a value in a cell containing a formula changes..."
If having your code run whenever a cell containing a formula is recalculated (which is not exactly what you asked for), one solution might be to create a VBA function that simply returns that value passed to it, plus does whatever else you want to do when the formula is recalculated...
Public Function Hook(ByVal vValue As Variant) As Variant
Hook = vValue
' Add your code here...
End Function
...then "wrap" your formula in a call to this function. For example, if the formula you are interested in is =A1+1, you would change this to =Hook(A1+1), and the Hook function would be called whenever A1+1 is recalculated (for example, when the value in A1 changes). However, it is possible that recalculating A1+1 will yield the same result and still call the Hook function (for example, if the user re-enters the same value in A1).
You can have a go at this:
First, in a Module Code declare a Public Variable.
Public r As Range, myVal '<~~ Place it in Module
Second, initialize your variables in Workbook_Open event.
Private Sub Workbook_Open()
Set r = Sheet1.Range("C2:C3") '<~~ Change to your actual sheet and range
myVal = Application.Transpose(r)
End Sub
Finally, set up your Worksheet_Calculate event.
Private Sub Worksheet_Calculate()
On Error GoTo halt
With Application
.EnableEvents = False
If Join(myVal) <> Join(.Transpose(r)) Then
MsgBox "Something changed in your range"
'~~> You put your cool stuff here
End If
myVal = .Transpose(r)
forward:
.EnableEvents = True
End With
Exit Sub
halt:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume forward
End Sub
Above will trigger the event when values in C2:C3 changes.
Not really very neat but works in detecting changes in your target range. HTH.
Declaring a module -level variable like Matteo describes is definitely one good way to go.
Brian 's answer is on the right track with regards to keeping all is the code in the same place, but it's missing one critical part : Application.Caller
When used in function that is called by a single cell, Application.Caller will return the Range object of that cell. This way you can store the old value within the function itself when it is called, then once you're done with calculating the new value you can compare it with the old and run more code as required.
Edit: The advantage with Application.Caller is that the solution scales in and of itself, and does not change no matter how the target cells are arranged (I.e. Continuous or not).
how do I, using VBA, make a G1 read only if any cell in a range say like A4:E50 has a value? My intent is to disable the option in G1 which is a drop down list, as soon as the user populates any of the cells in range A4:E50. If the users deletes all the values in the range, only then will the options in G1 be available. How do i achieve this?
This is a quick solution I just came up with... Not pretty, but it'll do the trick:
First run this macro just once:
Sub LockOneTime()
ActiveSheet.Cells.Locked = False
ActiveSheet.Range("G1").Locked = True
End Sub
Then put this in your worksheet code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.WorksheetFunction.CountA(Range("A1:E40")) > 0 Then
ActiveSheet.Protect contents:=True
Else
ActiveSheet.Protect contents:=False
End If
End Sub
It's a quick and dirty way to get what you're looking to achieve...
EDIT Based upon Other cells being Locked:
Given you can't use worksheet protection to avhieve your goal, just put this code in your worksheet's code module (You no longer need the first LockOneTime macro):
Private Sub Worksheet_Change(ByVal Target As Range)
If Not (Intersect(Target, Range("G1")) Is Nothing) Then
If Application.WorksheetFunction.CountA(Range("A4:E50")) > 0 Then
Application.EnableEvents = False
MsgBox "You cannot change the value in cell G1"
Application.Undo
Application.EnableEvents = True
End If
End If
End Sub
This won't let a change happen to cell G1, BUT its draw-back is, assuming you changed a lot of cells and G1 was one of them, it won't let any changes happen... In other words, if G1 is one of the cells being changed, then none of the cells will be allowed to be changed.
Hope this is ok by you, otherwise, the code gets a bit more complex and involved....