So i am currently using a classic "Run macro if Cell changes value":
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("O1"), Range(Target.Address)) Is Nothing Then
Call Macro A
End if
End Sub
Now i want to extend the macro so it checks every cell in the range Range("O1:O40"), and run a different macro depending on which cell that changes value.
The different macros could be placed in a loop, as the code is essentially:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("O1"), Range(Target.Address)) Is Nothing Then
Worksheets("Data").Range("N1").Value = Worksheets("Input").Range("O1").Value
ElseIf Not Application.Intersect(Range("O2"), Range(Target.Address)) Is Nothing Then
Worksheets("Data").Range("N2").Value = Worksheets("Input").Range("O2").Value
End if
End Sub
so if Worksheets("Input").Range("O1") changes value, the value must be copied to Worksheets("Data").Range("N1"), and so forth for all the cells in range "O1:O40"
You can run through the range using a For Each Loop
Dim cell As Range
For Each cell In Range("O1:O40")
If Not Application.Intersect(cell, Range(Target.Address)) Is Nothing Then
Worksheets("Data").Range("N" & cell.row).Value2 = cell.Value2
End If
Next cell
Related
I have the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$N$16" Then
Sheet3.Unprotect ""
Call QuantityisActivated(Target)
Sheet3.Protect ""
End If
End Sub
How can i use the same code for multiple Target.Adress for example, I want here from N16 to N30 range of cells
Sub QuantityisActivated(Target)
MsgBox "This is a sample box"
End Sub
The following can be used to only fire the QuantityisActivated if cells within the range are changed:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
Set rng = Intersect(Target, Range("N16:N30"))
If Not rng Is Nothing Then
'If you want it to run on each cell withing the range..
For Each c In rng.Cells
Call QuantityisActivated(c)
Next
'Or if you want it to run once, if any cell in range is affected
Call QuantityisActivated(rng)
End If
End Sub
I've included two possible ways of dealing with the affected range - either at a cell by cell level, or as an entire range as it's not clear which you'd prefer from your question.
I'm new to VBA so I'm probably making some beginner mistakes, please bare with me.
Here is the summary of my goal : I have several sheets in an Excel Workbook with the same structure. In each of those, I have a "Project Status" column with numbers ranging from 0 to 12. I'm trying to monitor a change in the column and, if the value of a cell changes, the row gets moved to the corresponding sheet and location.
My problem is that my code works but leaves an empty row where the row was cut. I tried adding
Target.EntireRow.Delete
but, if I add it before Insert the inserted row is empty, if I add it after it doesn't seem to do anything.
Here is a shorter version of my code, that I have in every sheet that is concerned by it :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A:A")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.ScreenUpdating = False
If Target.Value = 0 Then
Target.EntireRow.Cut
IdeasUpcoming.Range("4:4").Insert
End If
If Target.Value = 1 Then
Target.EntireRow.Cut
IdeasUpcoming.Range("4:4").Insert
End If
If Target.Value = 2 Then
Target.EntireRow.Cut
Current.Range("STATUSNewProjects").Offset(1, 0).Insert
End If
If Target.Value = 3 Then
Target.EntireRow.Cut
Current.Range("STATUSAdvancedProjects").Offset(1, 0).Insert
End If
If Target.Value = 4 Then
Target.EntireRow.Cut
Completed.Range("STATUSFinished").Offset(1, 0).Insert
End If
If Target.Value = 5 Then
Target.EntireRow.Cut
Completed.Range("STATUSOld").Offset(1, 0).Insert
End If
End If
bm_Safe_Exit:
Application.ScreenUpdating = True
End Sub
How can I delete the row I'm cutting? I'm sure the If / End If for each cell value aren't optimal, is there a way to simplify this (considering this is shortened, in reality I have 13 values)?
Thank you a lot for your help.
You can use the range.copy logic like this - then you can delete the row afterwards:
With Target.EntireRow
.Copy IdeasUpcoming.cells(4,1)
.Delete xlShiftUp
End With
Regarding your multiple checks:
Maybe you can create a configuration array, which holds per index the target sheets range after that the row should be inserted
Dim arrTarget(1 to 15) as range
set arrTarget(1) = IdeasUpcoming.Cells(4,1)
...
set arrTarget(4) = Completed.Range("STATUSFinished")
Then you can use it like this - without Ifs:
'insert new row for row to be copied
arrTarget(Target.value).Offset(1).EntireRow.Insert xlShiftDown
With Target.EntireRow
.Copy arrTarget(Target.value).Offset(1)
.Delete xlShiftUp
End With
Furthermore you should have one generic copy routine in a normal module
Public sub moveRows(Target as range)
'define arrTarget
'do the copying
End sub
And then you call this generic routine from either all worksheet_change routines
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A:A")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
moveRows target '-- this is where you call the generic sub
end if
End Sub
Or - if you have a sheetname logic to identify the relevant worksheets, e.g. data1, data2 etc. then you could use the workbook_SheetChange event (in the ThisWorkbook-module)
```vba
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name Like "data*" Then
Dim KeyCells As Range
Set KeyCells = Range("A:A")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
moveRows Target '-- this is where you call the generic sub
End If
End If
End Sub
In case you have to make changes to your move-routine or the worksheet_change event, you only have to make changes in one place :-). (DRY: Don't repeat yourself)
I need a macro that calls another macro when the value in cell A1 changes.
At the moment I am using the following code, but it seems to call the "pageupdate" sub every time the page recalculates, rather than just when the value in A1 actually changes from 0 to 1.
Does this issue stick out at anyone who understands the "Worksheet_Calculate" sub type or the logic behind the if statement.
Private Sub Worksheet_Calculate()
'|-------------------------------------------------|
'| Run Pageupdate |
'|-------------------------------------------------|
'If cell A1 recalculates affected by a change in the sheet/s, then this macro runs the 'PageUpdate' Macro.
'The point of this is to prevent the PageUpdate running when it doesn't need to.
Static OldVal As Variant
If Range("A1").Value <> OldVal Then
OldVal = Range("A1").Value
Call PageUpdate
End If
End Sub
Add the following sub as a Macro attached to the sheet you want to be
affected by the update and put your code inside this macro.
You can find the solution here
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("A1:A1")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
'MsgBox "Cell " & Target.Address & " has changed."
End If
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
I created this basic worksheet_change function which monitors column B. If a cell in column B gets deleted, it updates the delete in column C as well. The only issue is that since this is a change event, when more then 2 cells are altered at once, it throws a type mismatch error. This is because its comparing the Target.Address(s) to "" which is a type mismatch. How can I fix this to only run if only a single cell is select and not crash on a multiple cell select?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("B2:B51")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
If Range(Target.Address).Value = "" Then
Range("C" & Target.Row).Clear
End If
End If
End Sub
To simply check if the Target Range changed is more than one cell, you can simply count the cells in the range.
As mentioned in the comment, right after you declare the sub, you can add:
If Target.Count > 1 Then Exit Sub.
Alternatively, of course you could do, If Target.Count = 1 Then ...
Edit: Per your question above, you can do this to make sure events are on:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then
Application.EnableEvents = True
Exit Sub
End If
' Code here that will run, if the Target is just one cell
End Sub