I'm handling Change event in Excel using intersect like this:
Sub Worksheet_Change(ByVal Target As Range)
Dim WatchRange As Range
Dim IntersectRange As Range
Set WatchRange = Range("B2:B65536")
Set IntersectRange = Intersect(Target, WatchRange)
If IntersectRange Is Nothing Then
'Do Nothing
Else
For Each b In Target.Rows
Range("A" & b.Row).Value = "*"
Next
End If
End Sub
When I change something in column B, it writes * to column A. And it works great.
Problem happens when I set the filter and copy some value to filtered rows using CTRL+D. This is my test table:
Filter only text in column C:
And copy number 100 using CTRL+D to all visible rows (column B):
When I cancel the filter, all the rows are marked with *:
It wouldn't be a problem in small table, but it takes about 10sec in table with about 1000 rows.
Is it possible to skip hiden files somehow?
Use .EntireRow.Hidden to figure out if particular cell is filtered or not. Your code would look like:
Sub Worksheet_Change(ByVal Target As Range)
Dim WatchRange As Range
Dim IntersectRange As Range
Set WatchRange = Range("B2:B65536")
Set IntersectRange = Intersect(Target, WatchRange)
If IntersectRange Is Nothing Then
'Do Nothing
Else
For Each b In Target
If b.EntireRow.Hidden = False Then
Range("A" & b.Row).Value = "*"
End If
Next
End If
End Sub
Related
I have a list of "activities" in column B and each of them has a drop-down list for the status in column C. For each activity I can select "Done, In progress, TBD, Cancelled". What I want is to hide a row automatically (not filtering) every time I choose the status "Cancelled" in the drop-down (located in the same row).
The code used is below:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Set rng = Target.Parent.Range("C2:C21")
If Target.Address <> Range("C2:C21").Address Then
Exit Sub
Cells.EntireRow.Hidden = False
Select Case Range("C2:C21")
Case "Cancelled":
Range("2:21").EntireRow.Hidden = True - ***I want to hide only those rows in which "Cancelled" is selected.***
Case "Done":
Range("2:21").EntireRow.Hidden = False - ***I want the rows to unhide if either "Done","In progress" or "TBD" is selected.***
End Select
End Sub
It's probably a terrible code for what I want to do...
Any idea on how to improve this?
Thanks a lot in advance! :)
Sara
The rng object has never been used.
If you want to check the selection is in Range("C2:C21") or not, use a Intersect function.
The If statement can be completed without an End If only if it is one-lined. Otherwise you have to put an End If at the end.
Range("2:21").EntireRow.Hidden means every rows in 2:21 are going to be hidden.
Code:
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Dim rng As Range, cel As Range
Set rng = target.Parent.Range("C2:C21")
If Not Intersect(rng, target) Is Nothing Then
For Each cel In rng
cel.EntireRow.Hidden = IIf(cel.Value = "Cancelled", True, False)
Next cel
End If
End Sub
I'm not sure the version below is fitted or not. In my opinion, generally this macro should only be run after something is changed, and we can only check the row who has been changed, other rows should remain the same state.
Private Sub Worksheet_Change(ByVal target As Range)
Dim rng As Range, cel As Range
Set rng = target.Parent.Range("C2:C21")
If Not Intersect(rng, target) Is Nothing Then
target.EntireRow.Hidden = IIf(target.Value = "Cancelled", True, False)
End If
End Sub
This is another option, skipping the If and Select Case:
Private Sub Worksheet_Change(ByVal target As Range)
Dim myRng As Range
Dim myCell As Range
Set myRng = Range("C2:C21")
If Not Intersect(myRng, target) Is Nothing Then
Cells.EntireRow.Hidden = False
For Each myCell In myRng
myCell.EntireRow.Hidden = CBool(myCell = "Cancelled")
Next myCell
End If
End Sub
The "beauty" is that the If condition is eliminated and the .Hidden is assigned to a direct evaluation of myCell = "Cancelled";
Furthermore, the code is in a worksheet, as far as the _SelectionChange event is used. Then the parent worksheet of the range could be omitted, as far as it is taking the worksheet in which the code resides. So - Target.Parent.Range could be nicely skipped.
I have written a macro to color my cells green if the input is TRUE and red if the input to cell is FALSE.
Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveSheet.Name = "Ribs" Then
If Not Intersect(Target, Range("G2:K200")) Is Nothing Then
If Target = "False" Then
Sheets("Ribs").Range(Target.Address).Style = "Bad"
ElseIf IsNumeric(Target) Then
Sheets("Ribs").Range(Target.Address).Style = "Good"
End If
ElseIf Not Intersect(Target, Range("D2:D200")) Is Nothing Then
RotateRib (Target.Address)
End If
End If
End Sub
Now the problem is that if I change the range value (for example typing TRUE in cell G2 and than drag mouse pointer from bottom right corner of G2 to G10 should copy value TRUE to range G2:G10) raises Type Mismatch error in my macro.
Debugger says the problematic line is If Target = "False" Then.
Is there a workaround the given error? Ignoring the error would probably do the job, but it's not something I'd like to do.
The problem is that you're trying to do an illegal operation. You're asking the compiler to see if the contents of G2:G10 is equal to False - you can see this by adding Debug.Print Target.Address to the top of your code and then making another attempt.
It is possible to do what you want, but you'll need more code. When comparing values, you have to do it cell by cell - you can't compare an entire range at once. Here's a rudimentary example:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If ActiveSheet.Name = "Ribs" Then
For Each c In Target
If Not Intersect(c, Range("G2:K200")) Is Nothing Then
If c.Value = "False" Then
Sheets("Ribs").Range(c.Address).Style = "Bad"
ElseIf IsNumeric(c.Value) Then
Sheets("Ribs").Range(c.Address).Style = "Good"
End If
ElseIf Not Intersect(c, Range("D2:D200")) Is Nothing Then
RotateRib (c.Address)
End If
Next c
End If
End Sub
The principal change is that we're no longer comparing against Target, we're looping through all the individual cell contents (Range objects denoted as c) of Target and comparing against those.
Again, you can verify that this works by trying this code and filling down some values:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
For Each c In Target
Debug.Print c.Address
Next c
End Sub
There's absolutely no need to check the name of active sheet, since Worksheet_Change event fires on the sheet where it's defined.
Rather iterating over each cell in the Target, you could receive the intersection and apply your settings directly.
Don't forget about that Target can contain non-contiguous ranges (accessed by Areas property). My code handles this situation, but can't say the same about RotateRib.
To sum up:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngIntersect As Range, rngArea As Range, cell As Range
Set rngIntersect = Intersect(Target, Range("G2:K200"))
If Not rngIntersect Is Nothing Then
For Each rngArea In rngIntersect.Areas
For Each cell In rngArea
cell.Style = IIf(cell, "Good", "Bad")
Next
Next
End If
Set rngIntersect = Intersect(Target, Range("D2:D200"))
If Not rngIntersect Is Nothing Then RotateRib (rngIntersect)
End Sub
I have different set of values in cells G3:G4 and D15:D10000 in a single sheet. I want run two separate codes when G columns or D columns are changed. How I can identify which set of columns are changed?
out this in your worksheet code pane
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("G3:G4")) Is Nothing Then
'code when some cell in range "G3:G4" is changed
ElseIf Not Intersect(Target, Range("D15:D10000")) Is Nothing Then
'code when some cell in range "D15:D10000" is changed
End If
End Sub
Put the code below in your relevant worksheet, in the Worksheet_Change event.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WatchRange As Range
Dim IntersectRange As Range
Set WatchRange = Application.Union(Range("G3:G4"), Range("D15:D10000"))
Set IntersectRange = Intersect(Target, WatchRange)
If Not IntersectRange Is Nothing Then
Select Case Target.Column
Case 4 ' column D
Call A
Case 7 ' column G
Call B
End Select
End If
End Sub
Below are examples of Sub A and Sub B:
Sub A()
MsgBox "Running Sub A"
End Sub
Sub B()
MsgBox "Running Sub B"
End Sub
I am new to excel macro.
What I need to to is by clicking on specific cell in A column I will know It`s value. Can you help me with this?
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("D1:D200")) Is Nothing Then
MsgBox Range.("D" & Row_No).Value
End If
End If
End Sub
Use the code below to check the value of any cell in Column A once you click on it, this code should be added to your relevant Sheet to Worksheet_SelectionChange event :
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim WatchRange As Range
Dim IntersectRange As Range
' setting Column A as watched Range
Set WatchRange = Range("A:A")
Set IntersectRange = Intersect(Target, WatchRange)
If Not IntersectRange Is Nothing Then
If Selection.Count = 1 Then
MsgBox Target.Value
Else
MsgBox "You have selected more than 1 cell !"
End If
End If
End Sub
I'm trying to figure out a VBA code that will allow me to prefill a certain cell with a number when I type in "X" in a cell right next to it. I can't figure out if I should use Range, or Insert, or what.
I cannot use a button and assign a macro to it because I need to see which cells I have put an "X" into.
This is what I have so far, but it's using a button with macro assigned to it:
490 is being entered into E9 and tabs over to F9 after the macro button is clicked:
Sub eightNineSpring()
Range("E9").Select
ActiveCell.FormulaR1C1 = "490"
Range("F9").Select
End Sub
as automation put in the worksheet you need it:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 6 And Target.Count = 1 Then
If Target.Value = "x" Then Target.Offset(0, -1).Value = 490
End If
End Sub
or as formula in E1 then copy down
=IF(F1="x",490,"")
But keep in mind when deleting the "x" (or replace it with something different):
The function will empty the 490 again while the change event will not
When using a Change Events that makes a change, Application.Events should be turned off to avoid the code calling itself recursively.
The code below caters for one or more cells in E1:E10 being updated.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Intersect(Target, Range("F1:F10"))
If rng1 Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each rng2 In Range
If rng2.Value = "x" Then rng2.Offset(0, -1).Value = 490
Next
Application.EnableEvents = True
End Sub