I know there is an option to queue a macro by clicking into a cell. (Worksheet_SelectionChange)
But is there also an option where the macro gets queued if I change the cell font boldness?
I always want to start the macro when I change a cell to "bold".
I guess you might program your custom event for that specific case. A more simple approach can be to check if determined cell o cell in a determined range is put to bold and the call the macro.
Find a example where the msg is thrown when a bold cell is found in the range "A1:C10". It is triggered on selection change (so when pressing enter after setting the cell to bold).
You would need to call the macro you want where the message is thrown.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim KeyCells As Range
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("A1:C10")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
MsgBox "Cell " & Target.Address & " has changed."
For Each cell In KeyCells
If cell.Font.Bold = True Then
MsgBox ("a cell is bold!")
End If
Next cell
End If
End Sub
Related
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 am using a VBA change event to look for duplicates in column C. The code below works but when i delete all values within the range, blanks are triggered as duplicates so i need to include a way to ignore duplicates from the code. Any ideas?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
On Error GoTo ws_exit
Application.EnableEvents = False
With Target
If .Column = 3 Then
With .EntireColumn
Set cell = .Find(What:=Target.Value, AFter:=.Cells(1, 1))
If cell.Address = Target.Address Then
Set cell = .FindNext()
End If
If Not cell.Address = Target.Address Then
MsgBox "This Wall Reference already exists. Please ensure you have a unique reference identifier less than 20 characters in length", vbOKOnly
End If
End With
End If
End With
ws_exit:
Application.EnableEvents = True
End Sub
I expect to be able to ignore blanks but sill have the VBA run a duplication check to return a msgbox only if a duplication is found.
First you must consider that Target is a range of multiple cells and not only one cell. Therefore it is necessary to use Intersect to get all the cell that are changed in column 3 and then you need to loop through these cells to check each of them.
Also I recommend to use WorksheetFunction.CountIf to count how often this value occurs if it is >1 then it is a duplicate. This should be faster then using Find.
Note that the following code looks for duplicates in column 3 only if you want to check if a duplicate exists anywhere in the worksheet replace CountIf(Me.Columns(3), Cell.Value) with CountIf(Me.Cells, Cell.Value)
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AffectedRange As Range
Set AffectedRange = Intersect(Target, Me.Columns(3))
If Not AffectedRange Is Nothing Then
Dim Cell As Range
For Each Cell In AffectedRange
If Application.WorksheetFunction.CountIf(Me.Columns(3), Cell.Value) > 1 Then
MsgBox "This Wall Reference already exists. Please ensure you have a unique reference identifier less than 20 characters in length", vbOKOnly + vbExclamation
End If
Next Cell
End If
End Sub
Instead of using VBA you could also use Conditional Formatting to highlight duplicates in red for example. Could be easier to archieve (use the =CountIf formula as condition). And also it will always highlight all duplicates immediately which makes it easy to determine them.
Thanks for the help K.Davis. I appreciate your time and effort.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value = vbNullString Then Exit Sub
Dim cell As Range
On Error GoTo ws_exit
Application.EnableEvents = False
With Target
If .Column = 3 Then
With .EntireColumn
Set cell = .Find(What:=Target.Value, AFter:=.Cells(1, 1))
If cell.Address = Target.Address Then
Set cell = .FindNext()
End If
If Not cell.Address = Target.Address Then
MsgBox "This Glazing Reference already exists. Please ensure you have a unique reference identifier less than 20 characters in length", vbOKOnly
End If
End With
End If
End With
ws_exit:
Application.EnableEvents = True
End Sub
I need a macro that calls another macro when the value in cell A1 changes.
At the moment I am using the following code, but it seems to call the "pageupdate" sub every time the page recalculates, rather than just when the value in A1 actually changes from 0 to 1.
Does this issue stick out at anyone who understands the "Worksheet_Calculate" sub type or the logic behind the if statement.
Private Sub Worksheet_Calculate()
'|-------------------------------------------------|
'| Run Pageupdate |
'|-------------------------------------------------|
'If cell A1 recalculates affected by a change in the sheet/s, then this macro runs the 'PageUpdate' Macro.
'The point of this is to prevent the PageUpdate running when it doesn't need to.
Static OldVal As Variant
If Range("A1").Value <> OldVal Then
OldVal = Range("A1").Value
Call PageUpdate
End If
End Sub
Add the following sub as a Macro attached to the sheet you want to be
affected by the update and put your code inside this macro.
You can find the solution here
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("A1:A1")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
'MsgBox "Cell " & Target.Address & " has changed."
End If
End Sub
So i am currently using a classic "Run macro if Cell changes value":
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("O1"), Range(Target.Address)) Is Nothing Then
Call Macro A
End if
End Sub
Now i want to extend the macro so it checks every cell in the range Range("O1:O40"), and run a different macro depending on which cell that changes value.
The different macros could be placed in a loop, as the code is essentially:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("O1"), Range(Target.Address)) Is Nothing Then
Worksheets("Data").Range("N1").Value = Worksheets("Input").Range("O1").Value
ElseIf Not Application.Intersect(Range("O2"), Range(Target.Address)) Is Nothing Then
Worksheets("Data").Range("N2").Value = Worksheets("Input").Range("O2").Value
End if
End Sub
so if Worksheets("Input").Range("O1") changes value, the value must be copied to Worksheets("Data").Range("N1"), and so forth for all the cells in range "O1:O40"
You can run through the range using a For Each Loop
Dim cell As Range
For Each cell In Range("O1:O40")
If Not Application.Intersect(cell, Range(Target.Address)) Is Nothing Then
Worksheets("Data").Range("N" & cell.row).Value2 = cell.Value2
End If
Next cell
i am creating a user interacting form. i have two cells (assume A1 and B1). Now value of A1 is already defined and user has to enter value for B1 such that its a multiple of A1. Can i display a msgbox if he hadn't entered a multiple of A1 ?
The code below will run whenever B1 is changed. If you want to just add it into the code for your UserForm that take the if command I have marked.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("B1")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
// THIS CHECKS B1 AS A MULTIPLE OF A1
If Range("B1").Value Mod Range("A1").Value <> 0 Then
MsgBox "B1 is not a multiple of A1!"
End If
// END OF CHECK
End If
End Sub