working on this macro on a dependent drop down menu
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$M$10" Then
Range("O10").Value = "--select--"
End If
End Sub
I need to run this macro for all the cells in the column. It just work in the first cell
Can anyone help me please?
thanks!
You would need to use Application.Intersect in combination with .Offset() instead of the Target.Address method.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AffectedRange As Range
Set AffectedRange = Application.Intersect(Target, Me.Range("B:B")) 'find all cells that were changed in column B
If AffectedRange Is Nothing Then Exit Sub 'exit if nothing in column B was changed
Application.EnableEvents = False 'make sure our value change doesn't trigger another Worksheet_Change event (endless loop)
On Error GoTo ENABLE_EVENTS 'make sure events get enabled even if an error occurs
Dim Cell As Range
For Each Cell In AffectedRange.Cells 'loop through all changed cells in column B
Cell.Offset(ColumnOffset:=1).Value = "" 'move from B one column to the right and reset value
Next Cell
ENABLE_EVENTS: 'in case of error enable events and report the error
Application.EnableEvents = True
If Err.Number <> 0 Then
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End If
End Sub
This will observe column B and delete the value in C whenever a cell in B was changed.
Related
I am creating a budget in excel and I have copy and pasted a whole year worth of monthly budget outlines. Certain expenditures are all on the same row in multiple sheets in this workbook. I want to make it so whenever a numerical value is entered into a cell in those rows, it is immediately changed to a negative value.
There are non-number text in those rows so I want vba to only look for cells in those rows that have numbers.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Rows("22:52")) Is Nothing Then 'VBA change event for all sheets
Dim rng As Range
For Each rng In Intersect(Target, Rows("22:52"))
If Application.WorksheetFunction.IsNumber(Rows("22:52")) Then
If rng.Value > 0 Then c.Value = 0 - c.Values
End If
End If
Next rng
End Sub
The error I get is end if without block if.
I want to make it so whenever a numerical value is entered into a cell in those rows, it is immediately changed to a negative value.
Is this what you are trying?
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo Whoa
Application.EnableEvents = False
Dim aCell As Range
If Not Intersect(Target, Rows("22:52")) Is Nothing Then
For Each aCell In Target
If aCell.Value2 > 0 Then aCell.Value = -1 * aCell.Value2
Next aCell
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
Note: If you plan to change value of sheets which are not active then you will have to do what Tim mentioned on the comment above. For example if Sheet1 is active and you want to write to Sheet2.
Change
If Not Intersect(Target, Rows("22:52")) Is Nothing Then
to
If Not Intersect(Target, Sh.Rows("22:52")) Is Nothing Then
I need help automatically changing cells containing a certain value whenever a specific cell on same row changes value.
E.g whenever a cell in B column changes = change TRUE to FALSE on that specific row.
My VBA knowledge is pretty much nonexistent and Im certainly a beginner.
Im fairly sure that Worksheet.Change is what Im looking for and I've been trying out some code I've found here on SO, such as:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Target.Parent.Range("B:B")) Is Nothing Then Exit Sub
For Each x In Target
Cells(x.Row, 3).Value = "False"
Next
End Sub
I know though that this doesn't replace specific values in whatever column the cells are.
I've been trying out silly things like:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Target.Parent.Range("B:B")) Is Nothing Then Exit Sub
For Each x In Target
If Cells(x.Row, x.Column).Value = "TRUE" Then Value = "FALSE"
Next
End Sub
But of course it doesnt work.
Think you could point me out a direction of what I should be researching?
Replace the change event sub on the sheet where you have your data with the code below. I think that should do the trick
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oRng As Range
Dim oCell As Range
' Check if change was in column B
If Intersect(Target, Target.Parent.Range("B:B")) Is Nothing Then Exit Sub
' Turn off events so that when we make a change on the sheet, this event is not triggered again
Application.EnableEvents = False
' Set the range to include all column in Target row
Set oRng = Target.Parent.Range("C" & Target.Row & ":" & Target.Parent.Cells(Target.Row, Target.Parent.UsedRange.Columns.Count).Address)
' Loop through all cells to change the value
For Each oCell In oRng
If Trim(LCase(oCell.Value)) = "true" Then
oCell.Value = "FALSE"
End If
Next
' Enable events again
Application.EnableEvents = True
End Sub
I'm working with the Worksheet_Change(ByVal Target As Range) event.
I wanted to run a macro if either on of cells A1 or A2 are changed.
So the target range is set to [A1, A2]
Then, if A1 is changed, I want to clear A2, or the other way around (A2 is changed: clear A1).
Now the problem:
If A1 value is changed. the macro clears A2. That's seen as a change in A2, so it clears A1, which is a change, etc...
I'm sure it's something simple, but I can't see how I can have cell A1 be changed without triggering the change macro if A2 is being cleared.
Anyone who has experience in this?
You can accomplish this by toggling events off and on, like the following:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A1:A2")) Is Nothing Then Exit Sub
On Error GoTo SafeExit
Application.EnableEvents = False
If Target.Address = "$A$1" Then
Me.Range("A2").Clear
ElseIf Target.Address = "$A$2" Then
Me.Range("A1").Clear
End If
SafeExit:
Application.EnableEvents = True
End Sub
There are a few edge cases here, around changing more than one cell eg via copy pasting a range (possibly include other cells too).
Here's a version thats more robust in those cases
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Target, Me.Range("A1:A2"))
If rng Is Nothing Then Exit Sub
On Error GoTo SafeExit
Application.EnableEvents = False
Select Case rng.Address(0, 0)
' If both changed, what now? Default to clearing A2
Case "A1", "A1:A2"
If Not IsEmpty(Me.Cells(1, 1)) Then
Me.Cells(2, 1).Clear
End If
Case "A2"
If Not IsEmpty(Me.Cells(2, 1)) Then
Me.Cells(1, 1).Clear
End If
End Select
SafeExit:
Application.EnableEvents = True
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 have a table of values that I need to fill out through a worksheet change function.
What I am trying to do is change a cell in columns B-G, depending on where the target is.
Private Sub Worksheet_Change(ByVal Target As Range)
If (Not Intersect(Target, Range(Cells(12, 2), Cells(14, 7))) Is Nothing) Then
Cells(16,Application.WorksheetFunction.Column(Target))="Hello"
End If
End Sub
I have similar bits of code in the same worksheet_change sub that work fine when I use Target.Offset(1,0) but since my possible target range is in more than 1 Row, I don't know how to make it so that it is always row 16 and the same column as the target....
You need to deal with situations where Target is more than a single cell and disable event handling so when you change a value on the worksheet, the Worksheet_Change doesn't try to run on top of itself.
This will put 'hello' into the cell immediately to the right of any cell within B:G that changes; essentially you would be adding 'hello' to columns C:H on the associated row of each cell in Target.
Private Sub Worksheet_Change(ByVal Target As Range)
if not intersect(target, Range(Cells(12, "B"), Cells(14, "G"))) is nothing then
on error goto safe_exit
application.enableevents = false
dim t as range
for each t in intersect(target, Range(Cells(12, "B"), Cells(14, "G")))
t.Offset(1,0) = "hello"
next t
End If
safe_exit:
application.enableevents = true
End Sub