I am using a macro to write a datestamp when a column is modified. The idea is that whenever the status changes it gives the running time for that particular status. I have four columns:
A b c d
clearing 24.04.2015 1 empty
**when stauts is changed**
A b c d
wait for start 24.04.2015 2 24.04.2015
formual for c is :
IF(RC[-2]="";"";IF(RC[-2]="clearing";1;2))
Macro;
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Value = "clearing"
Then
Cells(Target.Row, 2) = Date
Else
If Target.Column = 3 And Target.Value = 2
Then
Cells(Target.Row, 4) = Date
End If
End If
End Sub
The problem is when C column is, with the help of formula, changed to 2 the macro does not automatically give me the date, but when I insert that manually it's working.
When you put values into the worksheet that is triggering the Worksheet_Change event macro, you should always turn off events or the macro will try to run on top of itself.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(1)) Is Nothing Then
On Error GoTo Fìn
Application.EnableEvents = False
Dim rng As Range
For Each rng In Intersect(Target, Columns(1))
If LCase(rng.Value) = "clearing" Then
Cells(rng.Row, 2) = Now
Cells(rng.Row, 2).NumberFormat = "dd.mm.yyyy"
'Cells(rng.Row, 3).FormulaR1C1 = "maybe put the formula in here"
ElseIf rng.Offset(0, 2).Value = 2 Then
Cells(rng.Row, 4) = Now
Cells(rng.Row, 4).NumberFormat = "dd.mm.yyyy"
End If
Next rng
End If
Fìn:
Application.EnableEvents = True
End Sub
It sounds like you already have that formula in column C but I left a place where you can put it in once column A gets the clearing value. Another option would be to simply write a 1 into column C and the next time write a 2 in column C. That way you wouldn't have to deal with the formula at all.
Related
I am a beginner in VBA.
I have a Column "AA" can have multiple values, driven by formula of which 2 are "Impact Assessed" or "Ready for retesting".
Problem Statement - I want to record the dates when cell's value is changed to Impact Assessed and Ready for Retesting in 2 separate columns - Column B and Column C, respectively. I also want the ability of the macro to run if I copy-paste more than 1 cells triggering the change in my Column AA.
Below is my code -
Private Sub Worksheet_Calculate()
Dim rng As Range
If Target.CountLarge > 1 Then Exit Sub
Set rng = Application.Intersect(Me.Range("AA:AA"), Target)
If Not rng Is Nothing Then
Select Case (rng.Value)
Case "2 - Impact Assessed": rng.Offset(0, 1).Value = Date
Case "4 - Ready for retesting": rng.Offset(0, 2).Value = Date
End Select
End If
End Sub
Something like this:
Private Sub Worksheet_Calculate()
Dim rng As Range, c As Range, v
'get all cells with formulas
On Error Resume Next
Set rng = Me.Range("A:A").SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
'got some cells - loop over each cell
If Not rng Is Nothing Then
For Each c In rng.Cells
'make sure there's no error
If Not IsError(c.Value) Then
Select Case c.Value
Case "2 - Impact Assessed"
AddDateIfEmpty c.Offset(0, 1)
Case "4 - Ready for retesting"
AddDateIfEmpty c.Offset(0, 2)
End Select
End If
Next c
End If
End Sub
'utility sub: add date only if not already present
Sub AddDateIfEmpty(c As Range)
If Len(c.Value) = 0 Then c.Value = Date
End Sub
I am trying to write a vba code and totally lost.
Basicially it would mean this:
**Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect ""
If Range("A11").Value = "NF" Then
Range("B11 and C11").Locked = false
ElseIf Range("A11").Value = (anything else other than NF) Then
Range("B11 and C11").Locked = true
End If 'Activesheet.protect ""
End sub**
I put A11 but in reality this has to apply to each row from A11 to A30.
Column A is where the employee manually fills in the project number, in B and C i have a vlookup searching the project number and brings back in b the project description and in c the project task.
But if the employee has no project number, he has to put NF, that means he can type in B and C to explain what he worked on in B and the task he did in C.
Therefore B and C are locked at all times but if he puts NF in A well b and c have to unlock so he can type in those two columns. And he has a possibility of entering 18 projects ranging from rows 11 to 30.
The code has to be able to do this from row 11 to 30.
After two days researching on the net , this is the best i came up with, all codes i found its either if you put in this do this and if you put in this do that. But in my case, if you put in this do this and if you put in anything else do this. Just can't get around it.
Please can someone help.
Here you go. Paste this code in a relevant Worksheet. Ensure to Unlock Column A of the worksheet to allow the users to type values even after the worksheet is being protected.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRange As Range
With Me
Set MyRange = .Range("A11:A20") ' Change the range according to your requirement
.Unprotect ""
If Not Intersect(Target, MyRange) Is Nothing Then
If Target.Value = "NF" Then
Target.Offset(0, 1).Locked = False
Target.Offset(0, 2).Locked = False
Else
Target.Offset(0, 1).Locked = True
Target.Offset(0, 1).Value = Application.Worksheetfunction.Vlookup(Target.value,Thisworkbook.worksheets("Project").Range("A:E"),4,0)
Target.Offset(0, 2).Locked = True
Target.Offset(0, 2).Value = Application.Worksheetfunction.Vlookup(Target.value,Thisworkbook.worksheets("Project").Range("A:E"),5,0)
End If
End If
.Protect ""
End With
End Sub
Hope this helps :)
I want to update 2 columns values based on another columns value (if value change). Suppose I have column A with a list (AA1, AA2, AA3), column B with a list (BB1, BB2), column C with a list (CC1, CC2). If a choose a value "AA1" from column A then Column B value should change to BB2 et column C to CC1. But nothing should happen if the value chosen in column A is different from "AA1". The same process occurs also for value "BB1" in column B. I added a vba but it not working. Also is there another way to do it without running a vba code ? Thanks
Private Sub Worksheet_Change(ByVal Target As Range)
Dim changedCells As Range
Set changedCells = Range("A:C")
If Not Application.Intersect(changedCells, Range(Target.Address)) Is Nothing Then
If Target.Count > 1 Then Exit Sub
If Target.Column = 1 And LCase(Target.Value) = "aa1"Then
Cells(Target.Row, 2) = "BB2"
Cells(Target.Row, 3) = "CC1"
ElseIf Target.Column = 2 And LCase(Target.Value) = "bb1" Then
Cells(Target.Row, 1) = "AA3"
Cells(Target.Row, 3) = "CC2"
ElseIf Target.Column = 3 And LCase(Target.Value) = "cc2" Then
Cells(Target.Row, 1) = "AA2"
Cells(Target.Row, 2) = "BB2"
End If
End If
End Sub
Your code is broadly OK, except it will cause an Event Cascade (changing a cell triggers the Worksheet_Change event, which changes a cell, which triggers Worksheet_Change, which ...)
You need to add Application.EnableEvents = False to prevent this (add ... = True at the end)
Here's your code refactored to address this, and a few other minor issues
Private Sub Worksheet_Change(ByVal Target As Range)
Dim changedCells As Range
On Error GoTo EH '~~ ensure EnableEvents is turned back on if an error occurs
Set changedCells = Me.Range("A:C") '~~ explicitly refer to the correct sheet
If Target.Count > 1 Then Exit Sub '~~ do this first, to speed things up
If Not Application.Intersect(changedCells, Target) Is Nothing Then '~~ Target is already a range
Application.EnableEvents = False '~~ prevent an event cascade
'~~ original If Then Else works fine. But can be simplified
Select Case LCase(Target.Value)
Case "aa1"
If Target.Column = 1 Then
Me.Cells(Target.Row, 2) = "BB2"
Me.Cells(Target.Row, 3) = "CC1"
End If
Case "bb1"
If Target.Column = 2 Then
Me.Cells(Target.Row, 1) = "AA3"
Me.Cells(Target.Row, 3) = "CC2"
End If
Case "cc2"
If Target.Column = 3 Then
Me.Cells(Target.Row, 1) = "AA2"
Me.Cells(Target.Row, 2) = "BB2"
End If
End Select
End If
'~~ Fall through to EnableEvents
EH:
Application.EnableEvents = True '~~ ensure EnableEvents is turned back on
End Sub
I found the attached when looking for how to due an event change to correct user data based on the values in two columns. I'm not a programmer, so I may have butchered the code as I combined two different solutions together.
Right now, it's working exactly as I want it to. Changing the offset cell value forces Excel to replace the target value with what I've specified. What I'm looking to achieve (and am not sure is possible), is to reverse the code. Basically, I want to change the offset cell, if the values are entered in the opposite order. The code will change the cell value to "Beta" if a user enters "Bravo" in column A, and then "Gamma" in column C.
What I'm trying to achieve is that if the user enters "Bravo" in column A second, that Excel still sees the combination of these cells and still replaces the value with "Beta". I know this is additional code, but I couldn't find anything to support replacing cell when the target cell isn't the value being updated.
Thanks in advance!
Dim oldCellAddress As String
Dim oldCellValue As String
Private Sub Worksheet_Change(ByVal Target As Range)
oldCellValue = "Bravo"
If Target = "Bravo" And Target.Offset(0, -2) = "Gamma" Then
Target.Value = "Beta"
Application.EnableEvents = True
End If
End Sub
This may meet your needs:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim colnum As Long, v As Variant
colnum = Target.Column
v = Target.Value
If colnum = 1 Then
If v = "Bravo" And Target.Offset(0, 2) = "Gamma" Then
Application.EnableEvents = False
Target.Value = "Beta"
Application.EnableEvents = True
End If
Exit Sub
End If
If colnum = 3 And v = "Gamma" And Target.Offset(0, -2) = "Bravo" Then
Application.EnableEvents = False
Target.Offset(0, -2).Value = "Beta"
Application.EnableEvents = True
End If
End Sub
For example if the user puts Bravo in cell A1 and C1 already contained Gamma, the code puts Beta in A1 (the code corrects the A1 entry).If the user puts Gamma in cell C1 and cell A1 already contained Bravo, the code corrects A1.
There are two possible scenarios like below...
Scenario 1:
If ANY CELL on the sheet is changed, the following code will check the content of column A and C in the corresponding row and change the content of the Target Cell.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim r As Long
r = Target.Row
On Error GoTo Skip:
Application.EnableEvents = False
If Cells(r, "A") = "Bravo" And Cells(r, "C") = "Gamma" Then
Target.Value = "Beta"
End If
Skip:
Application.EnableEvents = True
End Sub
Scenario 1:
If a cell in column D is changed, the change event will be triggered and check the content in column A and C in the corresponding row and change the Target Cell in Column D.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim r As Long
On Error GoTo Skip:
'The below line ensures that the sheet change event will be triggered when a cell in colunm D is changed
'Change it as per your requirement.
If Not Intersect(Target, Range("D:D")) Is Nothing Then
Application.EnableEvents = False
r = Target.Row
If Cells(r, "A") = "Bravo" And Cells(r, "C") = "Gamma" Then
Target.Value = "Beta"
End If
End If
Skip:
Application.EnableEvents = True
End Sub
I am currently trying to add a script into excel. excuse my terminology, I am not that hot with programming!
I do all of my accounting on excel 2003, and I would like to be able to add the value of say cells f6 to f27 to the cells e6 to e27, respectively. The thing is, I want the value of the "f" column to reset every time.
So far I have found this code, which works if I copy and paste it into VBA. but it only allows me to use it on one row:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = Range("f7").Address Then
Range("e7") = Range("e7") + Range("f7")
Range("f7").ClearContents
End If
Application.EnableEvents = True
End Sub
would somebody be kind enough to explain how I can edit this to do the same through all of my desired cells? I have tried adding Range("f7",[f8],[f9] etc.. but i am really beyond my knowledge.
First, you need to define the range which is supposed to be "caught"; that is, define the range you want to track for changes. I found an example here. Then, simply add the values to the other cell:
Private Sub Worksheet_Change(ByVal Target as Range)
Dim r as Range ' The range you'll track for changes
Set r = Range("F2:F27")
' If the changed cell is not in the tracked range, then exit the procedure
' (in other words, if the intersection between target and r is empty)
If Intersect(Target, r) Is Nothing Then
Exit Sub
Else
' Now, if the changed cell is in the range, then update the required value:
Cells(Target.Row, 5).Value = Cells(Target.Row, 5).Value + Target.Value
' ----------------^
' Column 5 =
' column "E"
' Clear the changed cell
Target.ClearContents
End if
End Sub
Hope this helps
Try this
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
If Intersect(Target, Range("B1:B5,F6:F27")) Then 'U can define any other range
Target.Offset(0, -1) = Target.Offset(0, -1).Value + Target.Value ' Target.Offset(0,-1) refer to cell one column before the changed cell column.
'OR: Cells(Target.row, 5) = Cells(Target.row, 5).Value + Target.Value ' Where the 5 refer to column E
Target.ClearContents
End If
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub