I am using this code to highlight the selected cell and it works fine. However, I was wondering if there is a better way of doing it without using On error resume next.
Also, If I use this statement does that mean other errors in the same event or procedures called by the event would not be catched?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Union(Me.Range("range_name"), Me.Range("range_name2"), _
Me.Range("range_name3"))) Is Nothing Then
Static xLastRng As Range
On Error Resume Next
Target.Interior.ColorIndex = 6
xLastRng.Interior.ColorIndex = xlColorIndexNone
Set xLastRng = Target
End If
End Sub
Here is another approach, because right now you are inputing a fill color instead of conditional formatting. You might ruin other cells their format doing so.
What I done is for example use this conditional formatting rule on column C, D and E (you have other ranges so use them accordingly).
=AND(ROW()=CELL("ROW"),COLUMN()=CELL("COLUMN"))
This alone should do the trick, but it's some kind of glitch (too fast) for the screen to properly update the selected cell with a conditional format. Scrolling down and back up fixes this and you will see that the selected cell is formatted if it is within your ranges.
To counter this I used a forced waiting time on a selection change in the worksheet untill Excel is done calculating...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Application.CalculationState = xlDone Then
DoEvents
End If
Application.ScreenUpdating = True
End Sub
No you will notice that it will not glitch out :)
If the glitch doesn't happen on your side, you can leave out the VBA part.
Try this:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static xLastRng As Range
Dim rng As Range
Set rng = Application.Intersect(Target, Union(Me.Range("range_name"), _
Me.Range("range_name2"), _
Me.Range("range_name3")))
'clear previous range hilite first, since overlap
' between previous & new could occur
If Not xLastRange Is Nothing Then
xLastRng.Interior.ColorIndex = xlColorIndexNone
Set xLastRange = Nothing
End If
If Not rng Is Nothing Then
Target.Interior.ColorIndex = 6
Set xLastRange = rng
End If
End Sub
It's unclear from your question whether you'd want to clear any previous highlighting if a new selection falls outside of your checked ranges.
I like this one!!
http://www.cpearson.com/excel/RowLiner.htm
Simply point to the Excel AddIn and run it.
https://trumpexcel.com/excel-add-in/
Related
Currently using this code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address = "$B$1" Then Range("B9:AE53").Interior.Color = xlNone
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Target, Range("B9:AE53")) Is Nothing Then
For Each c In Intersect(Target, Range("B9:AE53"))
Target.Interior.Color = vbYellow
Next c
End If
End Sub
Autohighlight only works when I manually edit (or F2 then enter) the cells in B9:AE53. I was hoping for something that would change the cell color if I edit the data in the orders sheet (reference for B9:AE53).
Was also hoping to transfer the event from B1 to a command button.
You can easily change the second part of your question, the one where you wish to reset the cell colors to nothing, to be executed by a button.
Change the code to this:
Sub CleanUp()
Range("B9:AE53").Interior.Color = xlNone
End Sub
Then add a button via the Forms Control Button in the developer toolbar and asign the above macro to it. This will clean up the area. Once you specifiy what the desired outcome is for the first part of you question I might be able to help with that.
I am trying to learn a bit of VB and there is an exercise to change a value and check the previous value and if it is different do something. I eventually found a solution I could understand and get to work from : How do I get the old value of a changed cell in Excel VBA? - solution 4.
My code is:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Variant
For Each cell In Target
If previousRange.Exists(cell.Address) Then
If Not Application.Intersect(Target, Me.Range("B12:B12")) Is Nothing Then
If previousRange.Item(cell.Address) <> cell.FormulaR1C1 Then
cell.Interior.ColorIndex = 36
End If
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
The next exercise was to add a button and perform an action depending on the user's response. So I added:
Private Sub CommandButton2_Click()
Dim currentValue, message As Integer
currentValue = Range("C3").Value
message = MsgBox("Click OK to add 1, cancel to leave", vbOKCancel, "Addition")
If message = 1 Then
Range("C3").Value = currentValue + 1
End If
End Sub
The problem I have is that the button adds one to C3 but then falls over at the If previousRange.Exists(cell.Address) statement on the Worksheet_Change sub.
All the code is defined on Sheet1, but I do not seem to have a previous value generated for my button value(C3). How do I generate the previous value, or what am I missing?
Regards
J
As I seemed to have made things worse I have created a new spreadsheet with just the change events code and nothing else to try and simplify the problem. So the complete code I have now is:
Option Explicit
Dim previousRange As New Dictionary
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Variant
For Each cell In Target
If previousRange.Exists(cell.Address) Then
If Not Application.Intersect(Target, Me.Range("B12:B12")) Is Nothing Then
If previousRange.Item(cell.Address) <> cell.FormulaR1C1 Then
cell.Interior.ColorIndex = 36
End If
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
Now if I change the B12 cell, the previousRange As New Dictionary code is highlighted, and a message states "Compile error:User defined type not defined".
This code used to work before I introduced the message box and made a subsequent change. Must be user error. Can you help?
Regards J.
The .Exists method is used on dictionary objects, like the example you've cited. But I don't see where you've declared a dictionary object in your code. Maybe you're missing a declaration statement for it?
Dim previousrange As New Dictionary
Please note that, like the solution you've cited, you'll need to declare this before the sub routine. Also, you'll need to enable the Microsoft Scripting Runtime. Here's how:
In the VBA editor, go to the Tools menu and click on References...
In the Available References list box, scroll down until you see Microsoft Scripting Runtime. Make sure its check box is checked.
Click OK.
Now you're able to use Dictionary objects.
My purpose is to run a macro automatically on some 20 cells across my active worksheet whenever these are edited. Instead of having the same macro in place for every cell individually (makes the code very long and clumsy), I want to create a for loop which goes something like this:
for i="A10","A21","C3" ... etc
if target.address = "i" then
'execute macro
end if
I'm not quite sure how to do this... maybe another way would be a better option?
I'd really appreciate your help in the matter - thank you very much indeed.
You can use the Worksheet_Change event. Below is sample code. You need to put the code on the sheet code section
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim rng As Range
Set rng = Range("A1:B5")
' If there is change in this range
If Not Intersect(rng, Target) Is Nothing Then
MsgBox Target.Address & " range is edited"
' you can do manipulation here
End If
Application.EnableEvents = True
End Sub
You can use the Worksheet_Change event to capture the edits. See http://msdn.microsoft.com/en-us/library/office/ff839775.aspx.
The event body receives a Range object that represents the modified cells. You can then use Application.Intersect to determine if one of your target cells is in the modified range.
Is there a simple way to get Excel to automatically execute a macro whenever a cell is changed?
The cell in question would be in Worksheet("BigBoard").Range("D2")
What I thought would be a simple Google inquiry is proving to be more complicated - every sample involved intersects (whatever those are) or color formatting or any other number of things that appear to be irrelevant.
Yes, this is possible by using worksheet events:
In the Visual Basic Editor open the worksheet you're interested in (i.e. "BigBoard") by double clicking on the name of the worksheet in the tree at the top left. Place the following code in the module:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("D2")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
On Error Goto Finalize 'to re-enable the events
MsgBox "You changed THE CELL!"
Finalize:
Application.EnableEvents = True
End Sub
Another option is
Private Sub Worksheet_Change(ByVal Target As Range)
IF Target.Address = "$D$2" Then
MsgBox("Cell D2 Has Changed.")
End If
End Sub
I believe this uses fewer resources than Intersect, which will be helpful if your worksheet changes a lot.
In an attempt to find a way to make the target cell for the intersect method a name table array, I stumbled across a simple way to run something when ANY cell or set of cells on a particular sheet changes. This code is placed in the worksheet module as well:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 0 Then
'mycode here
end if
end sub
In an attempt to spot a change somewhere in a particular column (here in "W", i.e. "23"), I modified Peter Alberts' answer to:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Target.Column = 23 Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
On Error GoTo Finalize 'to re-enable the events
MsgBox "You changed a cell in column W, row " & Target.Row
MsgBox "You changed it to: " & Target.Value
Finalize:
Application.EnableEvents = True
End Sub
I was creating a form in which the user enters an email address used by another macro to email a specific cell group to the address entered. I patched together this simple code from several sites and my limited knowledge of VBA. This simply watches for one cell (In my case K22) to be updated and then kills any hyperlink in that cell.
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("K22")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Range("K22").Select
Selection.Hyperlinks.Delete
End If
End Sub
I need to format a color (or bold text ...) of first row of multirow text cell. So e.g. I got
=myfunction (firstLine, secondLine), which then produces (inside one cell)
firstLine (vbLf)
secondLine
but i need it to produce
**firstLine** (vbLf)
secondLine
(the first line is bold)
So formating just a portion of a string but inside a VBA function. I could do it inside Sub with something like
lngPos = InStr(myCell.Value, vbLf)
With myCell.Characters(Start:=1, Length:=lngPos - 1).Font
.FontStyle = "Bold"
End With
but i cannot find a way how to do it inside a function, if it is even possible.
its not possible to do anything but return a value from a user defined function (UDF). You can trigger a worksheet event with the change however and then update data. Add this in the module for the relevant sheet. Change Range("J6:J10") to the range you need to monitor and add the bold / any additional code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("J6:J10")) Is Nothing Then
' do something on the cells
End If
End Sub
If you want to trigger the update via code as opposed to wait for a direct change (and formatting a cell does not trigger a Change event) then you could force it via a simple sub
You should always disable Events when working with the Change event to avoid unintended loops. While formatting won't trigger the event itself, further code changes/additions could do so - good practice to reduce this risk
normal module
Sub MakeUpdate()
Sheets(1).[a1:a10].Formula = Sheets(1).[a1:a10].Formula
End Sub
in the sheet code of Sheet(1)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Intersect(Target, [a1:a10])
If rng1 Is Nothing Then Exit Sub
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
For Each rng2 In rng1.Cells
rng2.Characters(1, InStr(rng2.Value, vbLf) - 1).Font.FontStyle = "Bold"
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub