I have the following code:
Sub ConditionalFormattingNamedRange()
Dim x As Range, Cell As Range
Set x = Range("AALB_Exposure")
For Each Cell In x
If Cell.Value > Sheets("Overview").Range("E4").Value Then
Cell.Interior.Color = RGB(0, 255, 0)
End If
Next
End Sub
Background information: This formula makes values in my defined range "AALB_Exposure" colored if they are larger than cell E4 on sheet "Overview". The value of cell E4 is the result of two other cells. Sometimes one of these cells varies. I have more than 20 defined ranges such as "AALB_Exposure", so I prefer to use a module.
Problem: This module makes all values colored. Sometimes there are some blank cells in "AALB_Exposure". I would like to see that this does not occurs. Is this possible?
In addition, this module is static and does not modifies the color of the cells in the defined range as I adjust E4. This happens only after I run the module. Is it possible to ensure that the color of cells adjust immediately depending on varying the values of E4.
Thank you!
----- Edit ------
After the excellent suggestion of Bruce Wayne, I changed my code a little bit.
Private Sub Workbook_SheetCalculate(ByVal Target As Range, ByVal Sh As Worksheet)
If Target.Address = "$A$9" Then
Application.ScreenUpdating = False
Dim x As Range, Cell As Range
Set x = Sh.Range("P1:P150,AD1:AD150,AR1:AR150,BF1:BF150,BT1:BT150,CH1:CH150,CV1:CV150,DJ1:DJ150,DX1:DX150,EL1:EL150")
For Each Cell In x
If Cell.Value > Sh.Range("A9").Value And Cell.Value <> "" Then
Cell.Interior.Color = RGB(0, 255, 0)
End If
Next
End If
Application.ScreenUpdating = True
End sub
As the named range is always the same for each sheet, it is maybe better to address the problem this way? Consequently, I changed Cell E4 that is located on the Overview sheet for a cell that is always on the same location for each sheet.
However, is this new module correct?
If you want this to run whenever E4 is changed, you need to put it in a Worksheet Change event:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$4" Then
Application.ScreenUpdating = False
Dim x As Range, Cell As Range
Set x = Range("AALB_Exposure")
For Each Cell In x
If Cell.Value > Sheets("Overview").Range("E4").Value And Cell.Value <> "" Then ' added `AND` part to check if cell is not blank
Cell.Interior.Color = RGB(0, 255, 0)
End If
Next
End If
Application.ScreenUpdating = True
End Sub
Put that in the Worksheet Module of the sheet you want to run it on. It will also check to see if the cell is blank or not before adding the color.
Related
I have rows from 1-100.
I know how to target specific cells and get data from them, but how would I do this when any row from 1 to 100 can be changed?
Say you put anything into Row A3. How would you write "Updated" into row B3 via VBA?
I want this to apply to rows A1-A100.
Thanks
Place the following event macro in the worksheet code area:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, Intersection As Range, Cell As Range
Set A = Range("A1:A100")
Set Intersection = Intersect(Target, A)
If Intersection Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each Cell In Intersection
Cell.Offset(0, 1).Value = "Updated"
Next Cell
Application.EnableEvents = True
End Sub
Open VBA Editor
Double click on the sheet you event take action (sheets appears in the left top box)
Select Worksheet on the left box above code box
Select change on the right box above code box
Paste the code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With ThisWorkbook.Worksheets("Sheet1")
If Not Intersect(Target, .Range("A1:A100")) Is Nothing Then
Application.EnableEvents = False
.Range("B" & Target.Row).Value = "Updated"
Application.EnableEvents = True
End If
End With
End Sub
I have VBA code that works, but does not seem to be optimal. The code should change the colour of the text in the relevant cell in columns H & I when a cell in Column N is clicked.
For example, when cell N5 is clicked, the text in cells H5 and I5 should turn white. When it is unclicked, they return to their normal colour.
The code does not seem to be optimal because the change in column I lags behind that in column H.
I would like a way to make both change instantaneously.
(Bonus points if you can make the cells change colour AND turn into bold instaneously, with the constraint that like for colour, the bold disappears once the cell is unselected).
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range
Intersect(Columns("H"), ActiveSheet.UsedRange).Font.Color = vbBlack
Set r = Intersect(Range("N:N"), Target)
If r Is Nothing Then Exit Sub
Cells(r.Row, "H").Font.Color = vbWhite
Intersect(Columns("I"), ActiveSheet.UsedRange).Font.Color = vbBlack
Set r = Intersect(Range("N:N"), Target)
If r Is Nothing Then Exit Sub
Cells(r.Row, "I").Font.Color = vbWhite
End Sub
Please note, this is my first time writing VBA, hence any amateurismes.
You don't need to address each column separately...
EDIT: added bold and multiple cells
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range, c As Range
Set r = Intersect(Me.Range("N:N"), Target)
'? what to do if user selects multiple cells ?
'E.g. - exit if user has >100 cells selected (possibly whole column)
If r Is Nothing Or Target.Cells.CountLarge > 100 Then Exit Sub
Application.ScreenUpdating = False
HighlightIt Application.Intersect(Me.Range("H:I"), Me.UsedRange), False
For Each c In r.Cells
HighlightIt Me.Cells(c.Row, "H").Resize(1, 2)
Next c
Application.ScreenUpdating = False
End Sub
'utility sub for highlighting/unhighlighting
Sub HighlightIt(rng As Range, Optional hilite As Boolean = True)
With rng
.Font.Color = IIf(hilite, vbWhite, vbBlack)
.Font.Bold = hilite
End With
End Sub
Always worth thinking about what should happen if the user selects multiple cells (or even a whole column). Handling this robustly is sometimes a challenge, depending on what you want to happen when they do that.
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
I am searching for a solution in excel. My goal is to enter a value in two different sheets but this value is the same in condition that if we change a value in any of these two sheets it will change automatically in the second one. So I can't use the =(reference to the cell) because it will create the link in one way.
Hope to find a solution.
This would do the trick. If I change the value of cell A1 in Sheet1, the value of cell A1 in Sheet2 is set be equal to that of A1 in Sheet1 and vice versa.
Past this code into Sheet1 in the VBA Editor. Then copy this code and also past this into Sheet2 - change "Sheet2" into "Sheet1" in the code (on line 15)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Changed As Range
Dim vNew As String
Set Changed = Range("A1")
Application.ScreenUpdating = False
Application.EnableEvents = False
If Not Intersect(Target, Changed) Is Nothing Then
vNew = Target.Value
Worksheets("Sheet2").Range("A1") = vNew
ActiveCell.Offset(1, 0).Select
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
Set Changed = Nothing
End Sub
Hope someone can answer us.
We want to do the following:
When a value is entered in A1, this value is added to the value of B1.
We then want the value of A1 too reset to 0, but keep the value of B1
Is this possible in excel?
On the worksheet's VBA private module (right-click the report tab and hit "View Code"), enter the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = Range("a1").Address Then
Range("b1") = Range("b1") + Range("a1")
Range("a1").ClearContents
End If
Application.EnableEvents = True
End Sub
Worksheet_Change is called whenever a change is made to the worksheet.
Application.EnableEvents=False prevents the code from running continuously (without it, the change to B1 would also call Worksheet_change).
This code assumes that the value in B1 is always numeric (or blank). If it may contain character text, then a check will need to be put in place to either reset its value or not do the increment.
Using simoco's suggestion:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A1 As Range
Set A1 = Range("A1")
If Intersect(Target, A1) Is Nothing Then
Else
Application.EnableEvents = False
With A1
.Offset(0, 1) = .Offset(0, 1) + .Value
.ClearContents
End With
Application.EnableEvents = True
End If
End Sub