Validating Cell Input Based on Another Cell - vba

When I input some text in a cell, for example in cell B2-test, I want in cell A6 the input to begin with this string and to end with _VAR1-for example test_VAR1.
I have found a simple solution as formula - =IF(A2="test","test_VAR1") but I want to make it as a VBA code.
So any idea how this can be done?

This is the most minimal example that I can come up with.
The LCase(Range("B2")) would also take "Test" and "TeSt" into account:
Option Explicit
Public Sub TestMe()
With ActiveSheet
If LCase(.Range("B2")) = "test" Then
.Range("A6") = .Range("B2") & "_VAR1"
End If
End With
End Sub
And if you want to check every event of the worksheet, put your code in the corresponding worksheet (Sheet1, Sheet2 and Sheet3 on the picture below):
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Me.Range("B2")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If LCase(Target) = "test" Then
Me.Range("A6") = Target & "_VAR1"
End If
Application.EnableEvents = True
End Sub

I know you said in your question you wanted macro, but I'm not going to post my own (because I feel like #Vityata's answer should be sufficient)
However, I got impression from your post, that you could adjust / improve your formula instead and avoid macro altogether. It's usually better to avoid macro, when possible, for compatibility reasons (a lot of users have macros disabled by default)
If you simply want to add the keyword "_VAR1" to the input, use the following formula instead
=LTRIM(B2) & "_VAR1"
If the input can be anything, that contains the word "test"
=IF(ISNUMBER(SEARCH("test", TRIM(LOWER(B2)))), LTRIM(B2) & "_VAR1", "Incorrect Input")
The text contains only the word "test" and nothing else
=IF(TRIM(LOWER(B2))="test", LTRIM(B2) & "_VAR1", "Incorrect input"
There are some other variations / tricks you could do with this, but these are some of the most basic examples you can use as your "building blocks"

Related

If Cells A1:C1= "No", All cells in the risk of the row will be blocked from input

Anyone know how to block cells from input (also gray it out) if for example cells A1:C1 = "No" then the rest of the row up to a say F1 is grayed out and blocked from input? I was hoping to do this in VBA but if there are other easier ways, please let me know! Thank you!
Didi
Just to show a different approach:
Put this in the sheet-code-tab:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not (Intersect(Target, Me.Range("D1:F1")) Is Nothing) And Me.Evaluate("AND(LOWER(A1:C1)=""no"")") Then Me.Range("A1").Select
End Sub
And to grey them out, best will be conditional formatting:
Range: =$D$1:$F$1
Formula: =AND(LOWER($A$1:$C$1)="no")
Using the conditional formatting allows to change the cells as you like without the need to alter the VBA code (this also will be faster)
The VBA part itself, just sets the selected cell to A1 if A1:C1 is "No" and a range is selected which also includes any of the cells of D1:F1
The LOWER can be skipped if you want it to be case sensitive
The only con is: if A1:C1 is "no" you still can paste a range to a cell (not any of D1:F1 directly) which also include the locked cells.
The biggest pro is: this also works for shared workbooks (as there is no need to lock/unlock sheets)
EDIT
If the cells need to be protected then something like this will do:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Boolean
a = Me.Evaluate("AND(LOWER(A1:C1)=""no"")")
If a <> Me.Range("D1").Locked Then
Me.Unprotect
Me.Range("D1:F1").Locked = a
Me.Protect
End If
End Sub
as was mentioned in the comments, look to use a workbook change event with the following sub
Sub test()
If Worksheets("Sheet1").Range("A1").Value = "no" And Worksheets("Sheet1").Range("B1").Value = "no" And Worksheets("Sheet1").Range("C1").Value = "no" Then
Worksheets("Sheet1").Range("D1:F1").Interior.Color = RGB(220, 220, 220)
Worksheets("Sheet1").Range("D1:F1").Locked = True
Worksheets("Sheet1").Protect
End If
End Sub

MsgBox when specific cells contain specific text

I would like to have a pop up message appear every time a cell contains specific text. Everytime the word "Red Level" is in any of this cells (I22,I23,I34,I35,I36), I would like a MsgBox to appear.
I am using a data validation list in all those cells mentioned above, to make sure the word "Red Level" is always the same.
I wrote some code and it worked but only when I had 1 cell in my range. When I tried to add the other cell numbers to my code, it will still only work for the first cell and not for the rest.
Below is the code that worked for one cell:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Worksheets("A12").Range("I22").Value = "Red Level" Then
MsgBox ("Please call maintenance immediately to refill reservoir")
End If
End Sub
I thought I could just add the rest of the cells to the range on my code, but that did not work.
This is what I did but did not work (The MsgBox will only appear when the word "Red Level is on I22 and not in the other cells):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Sheets("A12").Range("I22,I23,I34,I35,I36").Value = "Red Level" Then
MsgBox ("Please call maintenance immediately to refill reservoir")
End If
End Sub
You could use the worksheet's MATCH but it will not work on discontiguous cells so two checks must be made.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
if not iserror(application.match("red level", Range("I22:I23"), 0)) or _
not iserror(application.match("red level", Range("I34:I36"), 0)) then
'Red Level is is at least one of the discontiguous cells
MsgBox ("Please call maintenance immediately to refill reservoir")
end if
End Sub
It's unclear what actually drives 'Red Level' to appear in range("I22:I23, I34:I36"). This may be better as a Worksheet_Change. As is, the user cannot navigate through the worksheet if one or more of the cells remains 'Red Level'.
On a related note: is this within the A12 worksheet's code sheet? If so (as a private sub within the worksheet's code sheet), defining the parent worksheet with Worksheets("A12") is unnecessary. My code has removed the parent worksheet reference.
For this, you can do it two ways (at least). If you want to stay with If, you need lots of Or:
If Sheets("A12").Range("I22").Value = "Red Level" or Sheets("A12").Range("I23").Value = "Red Level" or ... Then
But as you can see, it'll be a really long line, which isn't the most straightforward to read. Here's an alternative:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
Dim addr() As Variant
Dim hasPrompted As Boolean
hasPrompted = False
addr = Array("$I$22", "$I$23", "$I$34", "$I$35", "$I$36")
Dim i As Long
For i = LBound(addr) To UBound(addr)
If Range(addr(i)).Value = "Red Level" And Not hasPrompted Then
MsgBox ("Please call maintenance immediately to refill reservoir")
hasPrompted = True
End If
Next i
Application.EnableEvents = True
End Sub
Note the second one will only fire one time, even if all cells have "Red Level", or just one cell has it. If you want to alert the user which cells have it, you can add that in, just let me know.
why not using find on the wanted cells range?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Worksheets("A12").Range("I22,I23,I34:I36").Find(what:="Red Level", LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then MsgBox "Please call maintenance immediately to refill reservoir"
End Sub
and, as #Jeeped already said, if the worksheet you're monitoring event of is named after "A12" then you can omit the Worksheets("A12"). part
The DATA tab has a wizard for data validation,
The first tab allows you to define a condition.
The third tab of this wizard is for a message popup.
You don't need to write code for this, S it is already built in to excel.
http://www.excel-easy.com/basics/data-validation.html

Change worksheet tab color if range of cells contains text

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

Macro launching when a cell value changes due to a formula not by the user

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).

Detect whether cell value was actually changed by editing

Worksheet_Change triggers when a cell value is changed (which is what I want), but it also triggers when you enter a cell as if to edit it but don't actually change the cell's value (and this is what I don't want to happen).
Say I want to add shading to cells whose value was changed. So I code this:
Private Sub Worksheet_Change(ByVal Target As Range)
Target.Interior.ColorIndex = 36
End Sub
Now to test my work: Change cell A1 and the cell gets highlighted. That's the desired behaviour. So far so good. Then, double click B1 but don't change the value there and then click C1. You'll notice B1 gets highlighted! And this is not the desired behaviour.
Do I have to go through the methods discussed here of capturing the old value, then compare old to new before highlighting the cell? I certainly hope there's something I'm missing.
I suggest automatically maintaining a "mirror copy" of your sheet, in another sheet, for comparison with the changed cell's value.
#brettdj and #JohnLBevan essentially propose doing the same thing, but they store cell values in comments or a dictionary, respectively (and +1 for those ideas indeed). My feeling, though, is that it is conceptually much simpler to back up cells in cells, rather than in other objects (especially comments, which you or the user may want to use for other purposes).
So, say I have Sheet1 whose cells the user may change. I created this other sheet called Sheet1_Mirror (which you could create at Workbook_Open and could set to be hidden if you so desire -- up to you). To start with, the contents of Sheet1_Mirror would be identical to that of Sheet1 (again, you could enforce this at Workbook_Open).
Every time Sheet1's Worksheet_Change is triggered, the code checks whether the "changed" cell's value in Sheet1 is actually different from that in Sheet1_Mirror. If so, it does the action you want and updates the mirror sheet. If not, then nothing.
This should put you on the right track:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
For Each r In Target.Cells
'Has the value actually changed?
If r.Value <> Sheet1_Mirror.Range(r.Address).Value Then
'Yes it has. Do whatever needs to be done.
MsgBox "Value of cell " & r.Address & " was changed. " & vbCrLf _
& "Was: " & vbTab & Sheet1_Mirror.Range(r.Address).Value & vbCrLf _
& "Is now: " & vbTab & r.Value
'Mirror this new value.
Sheet1_Mirror.Range(r.Address).Value = r.Value
Else
'It hasn't really changed. Do nothing.
End If
Next
End Sub
This code uses Comments to store the prior value (Please note if you do need the comments for other purposes this method will remove them)
Cells that have no value have colour reset to xlNone
An intial value typed into a cell is blue (ColorIndex 34)
If the value is changed the cell goes from blue to yellow
Normal module - turn display of comments off
Sub SetCom()
Application.DisplayCommentIndicator = xlNoIndicator
End Sub
Sheet code to capture changes
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim shCmt As Comment
For Each rng1 In Target.Cells
If Len(rng1.Value) = 0 Then
rng1.Interior.ColorIndex = xlNone
On Error Resume Next
rng1.Comment.Delete
On Error GoTo 0
Else
On Error Resume Next
Set shCmt = rng1.Comment
On Error GoTo 0
If shCmt Is Nothing Then
Set shCmt = rng1.AddComment
shCmt.Text Text:=CStr(rng1.Value)
rng1.Interior.ColorIndex = 34
Else
If shCmt.Text <> rng1.Value Then
rng1.Interior.ColorIndex = 36
shCmt.Text Text:=CStr(rng1.Value)
End If
End If
End If
Next
End Sub
Try this code. When you enter a range it stores the original cell values in a dictionary object. When the worksheet change is triggered it compares the stored values with the actuals and highlights any changes.
NB: to improve efficiency reference microsoft scripting runtime & replace the As Object with As Scripting.Dictionary and the CreateObject("Scripting.Dictionary") with New Scripting.Dictionary.
Option Explicit
Private previousRange As Object 'reference microsoft scripting runtime & use scripting.dictionary for better performance
'I've gone with late binding to avoid references from confusing the example
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Variant
For Each cell In Target
If previousRange.Exists(cell.Address) Then
If previousRange.Item(cell.Address) <> cell.FormulaR1C1 Then
cell.Interior.ColorIndex = 36
End If
End If
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cell As Variant
Set previousRange = Nothing 'not really needed but I like to kill off old references
Set previousRange = CreateObject("Scripting.Dictionary")
For Each cell In Target.Cells
previousRange.Add cell.Address, cell.FormulaR1C1
Next
End Sub
ps. any vba code to update cells (even just colour) will stop excel's undo functionality from working! To get around this you can reprogram undo functionality, but it can get quite memory intensive. Sample solutions: http://www.jkp-ads.com/Articles/UndoWithVBA00.asp / http://www.j-walk.com/ss/excel/tips/tip23.htm
I know this is an old thread, but I had exactly the same problem like this "Change cell A1 and the cell gets highlighted. That's what I'd expect. Double click B1 but don't change the value there and then click C1. You'll notice B1 gets highlighted! "
I didn't wanted to highlight a cell if it was only doubleclicked without value inside.
I solved in in easy way. Maybe it help somebody in future.
I've just added this on the beggining of the event:
If Target.Value = "" Then
Exit Sub
End If
I found this other thread that provides ways to captures the old value, so you can compare it with the "new" value and if those are then simply let it do nothing.
How do I get the old value of a changed cell in Excel VBA?