Add a Value Automatically to a Cell Based on Another Cell - excel

I want to add a value to a cell based on another with VBA but I'm not sure how. I already searched on internet about it but can't find anything.
I have a table, and on the Column C, if any cell contains the text "MAM" (because it might have MAM-565), then change the value from Cell A to "Wrong", but if it contains "NAC", then change value to "Correct". It should be in the same row as the text found.
Also, I want to add the date automatically to cell E every time Cell in D is filled.
This the code I have already:
Private Sub Worksheet_Change(ByVal Target As Range)
'Add Issue Type'
Dim Code As Range
Set Code = Range("C2:C100000")
For Each Cell In Code
If InStr(1, Cell, "NAC") Then
Range("A2:A10000").Value = "Correct"
ElseIf InStr(1, Cell, "MAM") Then
Range("A2:A10000").Value = "Wrong"
End If
Next
End Sub
This how my table looks like:
Table
Thanks in advance guys :)

To automatically add the datestamp:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng as Range
Set rng = Intersect(Target, Me.Range("D:D"))
If rng Is Nothing Then Exit Sub
On Error GoTo SafeExit
Application.EnableEvents = False
Dim cell as Range
For Each cell in rng
If Not IsEmpty(cell) Then ' don't do anything if cell was cleared
cell.Offset(,1).Value = Date
End If
Next
SafeExit:
Application.EnableEvents = True
End Sub
As far as the Correct/Wrong, this can easily be done with a formula (ISNUMBER(SEARCH(...)). I don't see the need for VBA here.
Even better, create a table using Ctrl+T. Excel will automatically add the formula in column A in new rows.

Related

Fill the cell with a formula if it's blank

I got a cell which has the formula: =SE(G15<>"";0;"") , it means depending the reference cell isn't blank, it must returns me a 0 in the that cell.
The thing is, sometimes I will have to manually change this cell to another numeric value, erasing the old formula I put, and then in the future this cell will never returns me the 0 again in case I don't put the same formula again.
I want to make a vba code which helps me in that. Every time I delete the cell with the value I put manually, it brings back the formula with the 0, and this in the range F16:Q16.
What I was trying to write is something like:
Sub Worksheet_Change(ByVal Target As Range)
and define the target.range for each cell, but I don't know how to progress anymore.
Please, can someone help in this?
Using the worksheet change event:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
Set rng = Application.Intersect(Target, Me.Range("F16:Q16")) 'range to be checked
If Not rng Is Nothing Then
On Error GoTo haveError
Application.EnableEvents = False 'stop updates from re-triggering this handler
For Each c In rng.Cells
If Not c.HasFormula And Len(c.Value) = 0 Then
c.Formula = "=IF(G15<>"""",0,"""")" 'use US-style from VBA
' or use FormulaLocal
End If
Next c
End If
haveError:
Application.EnableEvents = True 'make sure events are re-enabled
End Sub

VBA - if cell contains a word, then messagebox just one single time

My idea was to get an alert every time I digit the word "high" in a cell of column A (also if the word is contained in a longer string). This alert should pop up just if i edit a cell and my text contains "high" and I confirm (the alert shows when I press "enter" on the cell to confirm or just leave the edited cell). So I made this code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not IsError(Application.Match("*high*", Range("A:A"), 0)) Then
MsgBox ("Please check 2020 assessment")
End If
End Sub
The code seemed working fine. I digit "high" in a cell of column A and get the alert when I confirm- leave the cell.
The problem is that when i have a single "high" cell, the alert continues to pop up at every modification I do, in every cell. So is impossible to work on the sheet.
I need a code to make sure that, after digiting "high", i get the alert just one time, and then I do not get others when editing any cell, unless i digit "high" in another cell, or i go and modify a cell that already contains "high" and I confirm it again.
What could I do? Thanx!!
This will set a target (monitored range) and check if the first cell changed contains the word
Be aware that if you wan't to check every cell changed when you modify a range (for example when you copy and paste multiple cells), you'r have to use a loop
Private Sub Worksheet_Change(ByVal Target As Range)
' Set the range that will be monitored when changed
Dim targetRange As Range
Set targetRange = Me.Range("A:A")
' If cell changed it's not in the monitored range then exit sub
If Intersect(Target, targetRange) Is Nothing Then Exit Sub
' Check is cell contains text
If Not IsError(Application.Match("*high*", targetRange, 0)) Then
' Alert
MsgBox ("Please check 2020 assessment")
End If
End Sub
Let me know if it works
I tried your code; now, if column "A" has a cell "high", the alert correctly pop up and if then I edit cells in a column other than column "A", I don't get alert, so this is the good news!
The bad news is that if I have one single "high" in column A, when I edit any other cell in column "A" itself, I still get the alert everytime.
A Worksheet Change: Target Contains String
The message box will show only once whether you enter one ore multiple criteria values.
The Code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const srcCol As String = "A"
Const Criteria As String = "*high*"
Dim rng As Range: Set rng = Intersect(Columns(srcCol), Target)
If rng Is Nothing Then
Exit Sub
End If
Application.EnableEvents = False
Dim aRng As Range
Dim cel As Range
Dim foundCriteria As Boolean
For Each aRng In rng.Areas
For Each cel In aRng.Cells
If LCase(cel.Value) Like LCase(Criteria) Then
MsgBox ("Please check 2020 assessment")
foundCriteria = True
Exit For
End If
Next cel
If foundCriteria Then
Exit For
End If
Next aRng
Application.EnableEvents = True
End Sub
Sub testNonContiguous()
Range("A2,A12").Value = "high"
End Sub

Add Xlookup to a range via Excel VBA

I tried searching for a solution to my XLookup via VBA problem but I couldn't find one. I have this below data set:
In the Data Set, If any cell in the range C2:C6 is blank, I want to use this formula =IF(ISBLANK(B2),"",XLOOKUP(B2,A:A,IF(ISBLANK(D:D),"",D:D))) in those cells. Where row number of B2 is variable depending upon the row we are putting this formula via VBA.
If any cell in the range C2:C6 has value, I want to use that value without any formula. And if someone deletes the value and the cell becomes blank, VBA will add above formula to that cell.
Currently in the screenshot above, all the cells in range C2:C6 has above formula.
I hope I made sense. If this is not doable, it's okay. I can always use a helper column. But I think VBA would be a more cleaner way for my Dashboard.
Many Thanks in Advance.
In the sheet's class module, put this code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rCell As Range
For Each rCell In Me.Range("C2:C6").Cells
If IsEmpty(rCell.Value) Then
Application.EnableEvents = False
rCell.FormulaR1C1 = "=IF(ISBLANK(RC[-1]),"""",xlookup(RC[-1],C[-2],IF(ISBLANK(C[1]),"""",C[1])))"
Application.EnableEvents = True
End If
Next rCell
End Sub
This will run every time something on the sheet changes. That can't slow things down so you don't want to try to do too much in the Change event. It does not fire on calculate, though.
This one seems to be working for any set of data. Thanks to everyone for the help:
Private Sub InsertFormula()
Dim mwRng As Range
Set mwRng = Range("C2:C250")
Dim d As Range
For Each d In mwRng
If d.Value = "" Then
d.Formula = "=IF(RC[-1]="""",""-"",INDEX(C[1],MATCH(RC[-1],C[-2],0)))"
End If
Next d
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("C2:C250")) Is Nothing Then
Application.EnableEvents = False
Call InsertFormula
Application.EnableEvents = True
End If
End Sub

Excel VBA - clear cells above and below cell with text

I'm looking for some help please with some VBA.
Let's say I have a range of cells (B4:B12), so if I input data in a cell within the range I would like to clear all cells in the same range except for the cell in which I inputed the data. So that I can only have 1 cell with data in the range.
So if B5 had data and I inputed data in B7 then B5 would clear, then if i entered data in B10 then B7 would clear...
I hope there is a solution as I have been trying to find an answer for the past couple of hours.
I would do it this way:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Set myRange = Sh.Range("B4:B12")
'set the current cell/address/value so we don't lose them when the range is cleared
Set cell = Sh.Range(Target.address)
value = Target
'disable/enable so this isn't called every time a cell is cleared
'clear the range then reset the to entered value
If Not Intersect(Target, myRange) Is Nothing Then
Application.EnableEvents = False
myRange.Clear
cell.value = value
Application.EnableEvents = True
End If
End Sub
Or you could use worksheet event to bevplaced in the relevant worksheet code pane
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myVal As Variant
With Range("B4:B12") ‘reference your range
If Not Intersect(Target, .Cells) Is Nothing And Target.Count = 1 Then ‘ if changed range is one cell within the referenced one
myVal = Target.Value ‘store changed cell value
Application.EnableEvents = False
.ClearContents ‘ clear the content of referenced range
Target.Value = myVal ‘ write changed cell value back
Application.EnableEvents = True
End If
End With
End Sub

Creating place holder text in Excel

I'm still fairly new to excel but I can just about work out some simple formulas. I'm looking to create a placeholder text effect. The way I want to achieve this is like so;
Cell A1 : has the place holder text and is hidden.
Below this, cell B1 containing the formula.
This formula checks to see if Cell C1 is blank if C1 is blank it returns a value to C1. That value being the value of A1.
This is what I have in my head but I'm unsure on how to code this. I have bounced around the web for a while but I can't find a specific answer. The closest I have gotten is;
=IF(C6<>"","",C4)
Just to clarify Im looking to oput the result of formula B1 into C1.
OK, so put this in the worksheet's code module. Make sure you put it in the module for the specific sheet you're monitoring.
First, fill your range C5 through C99 with the formula like =$C$1. You should only need to do this one time, the macro will take care of it later.
Private Sub Worksheet_Change(ByVal Target As Range)
'the formula reference
Dim defaultFormula As String
defaultFormula = "=$C$1"
'The default text cell:
Dim defaultText As Range
Set defaultText = Range("C1")
'The cells you want to monitor:
Dim rng As Range
Set rng = Range("C5:C999") '## Modify as needed
'Cell iterator
Dim cl As Range
If Intersect(Target, rng) Is Nothing Then Exit Sub
'Avoid infinite looping
Application.EnableEvents = False
'If the user has deleted the value in the cell, then replace it with the formula:
For Each cl In Intersect(Target, rng)
If Trim(cl.Value) = vbNullString Then
cl.Formula = defaultFormula
End If
Next
'Turn on Events:
Application.EnableEvents = True
End Sub
What this does is (hopefully) pretty self-explanatory from the comments in the above code The Change event is raised any time a cell on the worksheet is changed.

Resources