I am using the code below to run a macro Calendar_Advanced if any cell is selected in column M.
Problem: If I select any cell in the same time with Range M:M , the event also fires, like if I selected all row.
Private Sub worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim LastRow As Long: LastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
If Not Intersect(Target, Range("M3:M" & LastRow)) Is Nothing Then
Call Calendar_Advanced
End If
End Sub
I tried to add to the If condition And Selection.Cells.Count = 1.
It works, but prevents multi selection (Calendar_Advanced) to run on column M.
Count the columns to make sure it is just M.
Private Sub worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim LastRow As Long: LastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
If Not Intersect(Target, Range("M3:M" & LastRow)) Is Nothing Then
If Target.Columns.Count = 1 Then
Calendar_Advanced
End If
End If
End Sub
Related
I am trying to write for a worksheet change event for two non contiguous range , which are cells A&lastrow and C&lastrow. For example, if lastrow=5, then it is A5, and C5, while excluding B5. This is my code, and it is not working, any idea on how to fix the syntax.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastrow As Long
lastrow = 5
If Not Intersect(Target, Range("A & lastrow, C & lastrow ")) Is Nothing Then
MsgBox "Hello"
End If
End Sub
Within Mathieu Guindons code snippet there are too many quotation marks.
This works code shows the msgbox when cell A5 or C5 are changed
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastrow As Long
lastrow = 5
If Not Intersect(Target, Me.Range("A" & lastrow & ", C" & lastrow)) Is Nothing Then
MsgBox "hello"
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
StartRow = 21
EndRow = 118
ColNum = 1
For i = StartRow To EndRow
If Cells(i, ColNum).Value = Range("A4").Value Then
Cells(i, ColNum).EntireRow.Hidden = True
Else
Cells(i, ColNum).EntireRow.Hidden = False
End If
Next i
End Sub
The Range I want to dictate when the code is run is D21:D118. It will start out blank and then have data pulled into it
Thank you!
It's quite difficult and error-prone to tell in a Change event handler what the previous cell value was before it was edited. You might consider narrowing the logic so it only runs if a cell in A21:A118 is changed.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range, vA4
'Does Target intersect with our range of interest?
Set rng = Application.Intersect(Target, Me.Range("A21:A118"))
If rng Is Nothing Then Exit Sub 'no change in monitored range
vA4 = Me.Range("A4").Value
For Each c In rng.Cells 'loop over updated cells
c.EntireRow.Hidden = (c.Value = vA4) 'check each updated cell value
Next c
End Sub
When A1 changes, I want to insert a formula to first row and drag it down to last row.
First row is where string "ABC" in column D offset by 2 columns to the right (how do I use offset function instead of just putting 5?)
My try:
Option Explicit
Private Sub WorkSheet_Change(ByVal Target As Range)
Dim firstrow As Long, lastrow As Long
If Not Intersect(Target, Range("A1")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
firstrow = .Cells(Application.WorksheetFunction.Match("ABC", .Range("D:D"), 0), 6)
lastrow = .Cells(fr).End(xlDown).Row
With Range(firstrow, lastrow)
.Formula = "=$F$1+G1"
End With
End If
End Sub
Obviously this doesn't seems to work...
I know there got to be easier and much clever/simpler ways to do this
Thank you for the help.
I'm not sure exactly which column should be used to determine the lastRow, but something like this should do the trick:
Private Sub WorkSheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Me.Range("A1")) Is Nothing Then
Dim firstRow As Variant
firstRow = Application.Match("ABC", Me.Range("D:D"), 0)
If Not IsError(firstRow) Then
Dim lastRow As Long
lastRow = Me.Cells(Me.Rows.Count, "D").End(xlUp).Row
Me.Range("F" & firstRow & ":F" & lastRow).Formula = "=$F$1+G1"
End If
End If
End Sub
I have a table with data from A5:S and would like to sort by a column with "segment" in headline every time a line is inserted.
I have made a numeric column to the left of my string column "segment" which matches my "ranking", the only issue is that it doesn't sort the rows automatically.
I have tried this VBA, but nothing happen:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A5:S" & lastRow).Sort key1:=Range("A5:A" & lastRow), order1:=xlAscending, Header:=xlGuess
End If
End Sub
If you keep a count of the #of rows in Column A, then when you insert a row, the worksheet_change event can run when the rows increase.
Possible adding enableevents to false would be a good idea so the change_evnt does not kick in when sorting
Dim LstRw As Long
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rws As Long
Rws = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
If Rws > LstRw Then
Application.EnableEvents = False
MsgBox "Run your code here!"
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
LstRw = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
End Sub
What about if you change:
if target.column = 2 then
for
if activecell.column = 2 then
the combination of this sub in a module
Sub hithere3()
Dim Rng As Range
Dim Unique As Boolean
For Each Rng In Worksheets("Sheet8").Range("FS3:FS30") 'for each cell in your B1 to B30 range, sheet1
Unique = True 'we'll assume it's unique
Lastunique = Worksheets("TRADES").Range("C:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = 3 To Lastunique 'for each cell in the unique ID cache
If Rng.Value = Worksheets("TRADES").Cells(i, 3).Value Then 'we check if it is equal
Unique = False 'if yes, it is not unique
End If
Next
If Unique Then Worksheets("TRADES").Cells(Lastunique + 1, 3) = Rng 'adds if it is unique
Next
End Sub
with the loop check in a worksheet change events
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("FS3:FS33")) Is Nothing Then
'Do nothing '
Else
Call hithere3
End If
End Sub
works except it only updates when I select one of the cells in FS3:FS33
Can anyone suggest how this can be overcome?
maybe with a workchange change range selection type from below?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Dn As Range, n As Long
Dim RngB As Range, RngC As Range
If Target.Column = 2 And Target.Count = 1 And Target.Row > 1 Then
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
Set RngB = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
Set RngC = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
ray = Array(RngB, RngC)
For n = 0 To 1
For Each Dn In ray(n)
If Not Dn.Address(0, 0) = "C1" And Not Dn.Value = "" Then
.Item(Dn.Value) = Empty
End If
Next Dn
Next n
Range("C2").Resize(.Count) = Application.Transpose(.Keys)
End With
End If
Use either the worksheet Calculate event or the worksheet Change event:
use Calculate if the range contains formulas
use Change if the cells in the range are changed manually
If Intersect(Target, Range("FS3:FS33")) Is Nothing is the culprit. You must change Range("FS3:FS33") to whatever range you want to affect this change.
Private Sub Worksheet_Change(ByVal Target As Range) '<<delete the "Selection" from the name of event
If Intersect(Target, Range("FS3:FS33")) Is Nothing Then
'Do nothing '
Else
Call hithere3
End If
End Sub
Finally figured it out, the following code works :
Private Sub Worksheet_calculate()
If Range("FS3:FS33") Is Nothing Then
'Do nothing'
Else
Call hithere3
End If
End Sub