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
Related
I am trying to enforce a specific date format on a sheet where dates will be manually entered or pasted on a regular basis. Since Excel's built-in data validation does not work for pasted values, I am trying to accomplish this with VBA.
This is the code I have written/hodgepodged together from other Stack posts:
Option Explicit
Function dateCheck(cellval As Date) As Boolean
If IsDate(cellval) And cellval.NumberFormat <> "yyyy-dd-mm" Then
MsgBox "Please use the yyyy-dd-mm date format!"
dateCheck = True
End If
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AffectedCells As Range
Dim Cell As Range
Dim A As Boolean
'rule 1: column A allows only text length up to 9
Set AffectedCells = Intersect(Target, Target.Parent.Range("collection_dates"))
If Not AffectedCells Is Nothing Then
For Each Cell In AffectedCells
A = dateCheck(Cell.Value)
If A = True Then
Application.Undo 'undo insert
Exit Sub 'stop checking after one invalid data was found.
End If
Next Cell
End If
End Sub
"collection_dates" is a range of cells I named, which I want to enforce formatting on.
The error I'm currently getting is a "Run-time error '13': type mismatch" on the line A = dateCheck(Cell.Value)
I have tried various other iterations of this and gotten various other errors; I think I am just fundamentally missing something about how to properly validate a cell value in VBA.
I took the advice from some of the comments and stopped attempting to enforce the formatting at this level, since what was really important to me was that dates were entered correctly, ie. not typos.
I had to make some changes to accommodate blank cells or else the Application.Undo would loop endlessly if an incorrect value was entered and cleared. This is the final product, which appears to be working:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AffectedCells As Range
Dim Cell As Range
'rule 1: only allow dates to be entered in affected cells
Set AffectedCells = Intersect(Target, Target.Parent.Range("collection_dates"))
If Not AffectedCells Is Nothing Then
For Each Cell In AffectedCells
If Not IsDate(Cell.Value) Then
If Trim(Cell.Value) = "" Then
GoTo DoNothing
Else
MsgBox "Please enter a valid date!", vbCritical
Application.Undo 'undo insert
Exit Sub 'stop checking after one invalid data was found.
End If
End If
DoNothing:
Next Cell
End If
End Sub
I'm trying to make a code which after insert/update value in one cell, will go to the next cell like on the picture. Now this code works only one way:
ActiveCell.Offset(1,0).Select ex. from A2 to B2.
What to do to return offset to the cell on the left from B2 to A3 - need loop like on the picture.
I am not quite sure if I understood what you are looking!
I set a range on column A and B until row 10, just for testing.
This code moves to the next cell on the picture whenever you edit
the cell and then you press Enter.
Put this code on the sheet module
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngColA As Range: Set rngColA = Range("A2:A10")
Dim rngColB As Range: Set rngColB = Range("B2:B10")
If Not Intersect(Target, rngColA) Is Nothing Then
Target.Offset(0, 1).Select
exit sub
End If
If Not Intersect(Target, rngColB) Is Nothing Then
Target.Offset(1, -1).Select
End If
End Sub
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
I need help automatically changing cells containing a certain value whenever a specific cell on same row changes value.
E.g whenever a cell in B column changes = change TRUE to FALSE on that specific row.
My VBA knowledge is pretty much nonexistent and Im certainly a beginner.
Im fairly sure that Worksheet.Change is what Im looking for and I've been trying out some code I've found here on SO, such as:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Target.Parent.Range("B:B")) Is Nothing Then Exit Sub
For Each x In Target
Cells(x.Row, 3).Value = "False"
Next
End Sub
I know though that this doesn't replace specific values in whatever column the cells are.
I've been trying out silly things like:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Target.Parent.Range("B:B")) Is Nothing Then Exit Sub
For Each x In Target
If Cells(x.Row, x.Column).Value = "TRUE" Then Value = "FALSE"
Next
End Sub
But of course it doesnt work.
Think you could point me out a direction of what I should be researching?
Replace the change event sub on the sheet where you have your data with the code below. I think that should do the trick
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oRng As Range
Dim oCell As Range
' Check if change was in column B
If Intersect(Target, Target.Parent.Range("B:B")) Is Nothing Then Exit Sub
' Turn off events so that when we make a change on the sheet, this event is not triggered again
Application.EnableEvents = False
' Set the range to include all column in Target row
Set oRng = Target.Parent.Range("C" & Target.Row & ":" & Target.Parent.Cells(Target.Row, Target.Parent.UsedRange.Columns.Count).Address)
' Loop through all cells to change the value
For Each oCell In oRng
If Trim(LCase(oCell.Value)) = "true" Then
oCell.Value = "FALSE"
End If
Next
' Enable events again
Application.EnableEvents = True
End Sub
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.