I am trying to update values entered into cells in Column A. I have the following script which works as expected, almost. It updates the cell, but then continues to update until it reaches an exponentially large number.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
intcolumn = Target.Column
introw = Target.Row
Cells(introw, intcolumn) = Cells(introw, intcolumn) * "12"
End If
End Sub
Is there a way to make it so that I can make it so I can enter any number in A? and have it only multiply by 12 once? (1 = 12, 2 = 24, 3 = 36, 4 = 48, etc.)
Your change is triggering the Worksheet_Change event again. You need to have some kind of flag to keep track of it:
Private changeFlag As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Not changeFlag Then
changeFlag = True
intcolumn = Target.Column
introw = Target.Row
Cells(introw, intcolumn).Value = Cells(introw, intcolumn).Value * 12
Else
changeFlag = False
End If
End Sub
Multiplying the cell value triggers the Worksheet_Change event, which is triggering this macro. So, when you enter "1" in to cell A1, this is a change that causes multiplication 1*12=12, but this is also a change, which causes 12*12=144, which is also a change, etc., which is why it's repeating.
This should fix it, disable events before performing the operation, then re-enable events before exiting the subroutine:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Application.EnableEvents = False 'Prevent looping based on the 'change' caused by multiplication
intcolumn = Target.Column
introw = Target.Row
Cells(introw, intcolumn) = Cells(introw, intcolumn) * "12"
Application.EnableEvents = True 'allow events again
End If
End Sub
Related
so i have a sheet and whenever something in the range of A10:A23 is changed/updated, it is supposed to put a timestamp in the according column in Row B, however it isnt working and i have no idea why.
I already set the sheets code to "Worksheet" and "change"
Here is my code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = A And Target.Column >= 10 And Target.Column <= 23 Then
Cells(Target.Column, B) = Now()
End If
End Sub
Thanks in advance!
Assuming you will only change one cell at a time (which is not always true):
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A10:A23")) Is Nothing Then
If Target.Count = 1 Then
Application.EnableEvents = False
Target.Offset(0, 1) = Now()
Application.EnableEvents = True
End If
End If
End Sub
I want to update 2 columns values based on another columns value (if value change). Suppose I have column A with a list (AA1, AA2, AA3), column B with a list (BB1, BB2), column C with a list (CC1, CC2). If a choose a value "AA1" from column A then Column B value should change to BB2 et column C to CC1. But nothing should happen if the value chosen in column A is different from "AA1". The same process occurs also for value "BB1" in column B. I added a vba but it not working. Also is there another way to do it without running a vba code ? Thanks
Private Sub Worksheet_Change(ByVal Target As Range)
Dim changedCells As Range
Set changedCells = Range("A:C")
If Not Application.Intersect(changedCells, Range(Target.Address)) Is Nothing Then
If Target.Count > 1 Then Exit Sub
If Target.Column = 1 And LCase(Target.Value) = "aa1"Then
Cells(Target.Row, 2) = "BB2"
Cells(Target.Row, 3) = "CC1"
ElseIf Target.Column = 2 And LCase(Target.Value) = "bb1" Then
Cells(Target.Row, 1) = "AA3"
Cells(Target.Row, 3) = "CC2"
ElseIf Target.Column = 3 And LCase(Target.Value) = "cc2" Then
Cells(Target.Row, 1) = "AA2"
Cells(Target.Row, 2) = "BB2"
End If
End If
End Sub
Your code is broadly OK, except it will cause an Event Cascade (changing a cell triggers the Worksheet_Change event, which changes a cell, which triggers Worksheet_Change, which ...)
You need to add Application.EnableEvents = False to prevent this (add ... = True at the end)
Here's your code refactored to address this, and a few other minor issues
Private Sub Worksheet_Change(ByVal Target As Range)
Dim changedCells As Range
On Error GoTo EH '~~ ensure EnableEvents is turned back on if an error occurs
Set changedCells = Me.Range("A:C") '~~ explicitly refer to the correct sheet
If Target.Count > 1 Then Exit Sub '~~ do this first, to speed things up
If Not Application.Intersect(changedCells, Target) Is Nothing Then '~~ Target is already a range
Application.EnableEvents = False '~~ prevent an event cascade
'~~ original If Then Else works fine. But can be simplified
Select Case LCase(Target.Value)
Case "aa1"
If Target.Column = 1 Then
Me.Cells(Target.Row, 2) = "BB2"
Me.Cells(Target.Row, 3) = "CC1"
End If
Case "bb1"
If Target.Column = 2 Then
Me.Cells(Target.Row, 1) = "AA3"
Me.Cells(Target.Row, 3) = "CC2"
End If
Case "cc2"
If Target.Column = 3 Then
Me.Cells(Target.Row, 1) = "AA2"
Me.Cells(Target.Row, 2) = "BB2"
End If
End Select
End If
'~~ Fall through to EnableEvents
EH:
Application.EnableEvents = True '~~ ensure EnableEvents is turned back on
End Sub
I am looking to parse an entire row in a particular excel sheet for any change in data in that row. If there is any change in data in that row then i want to add the date in which that particular cell of that row. I want to pass the row as an input. I tried the following code but it doesnt work.
Private Function User_func1(ByVal i As Long)
Dim j As Long
For j = 1 To j = 100
If Cells(i, j).Value > 1 Then
Cells(i, 2) = Now()
End If
Next j
End Function
You can use the Worksheet_Change event in the sheet you want to scan.
Option Explicit
Const RowtoTest = 2
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Row = RowtoTest Then
Target.Value = Date
End If
Application.EnableEvents = True
End Sub
Option 2: Get the row to test from a certain cell, lets say Cell "A1" (value is set to 2, means look for changes in cells in row 2).
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
' compare the row number to the number inputted as the row to test in cell A1
If Target.Row = Range("A1").Value Then
Target.Value = Date
End If
Application.EnableEvents = True
End Sub
I've found some examples of how to highlight the row of the currently selected cell. My issue is that I need to do this only in rows 3 and higher.
This is what I picked up so far:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Cells.Interior.ColorIndex = 0
With Target
.EntireRow.Interior.ColorIndex = 8
End With
Application.ScreenUpdating = True
End Sub
This works as advertised, but I am struggling with how to not lose the background color I have for header cells in rows 1 and 2. I am sure it requires an "if" of some sort, but I am not sure where I need to put it.
Also, is there anyway I can apply this to the entire workbook? I have 60 sheets in the workbook and if I can not replicate the code 60 times that would be ideal.
Any help is greatly appreciated.
The following code will do the trick:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Row <> 1 and Target.Row <> 2 Then
Application.ScreenUpdating = False
Cells.Interior.ColorIndex = 0
Range("A1:AF2").Interior.ColorIndex = 47
Target.EntireRow.Interior.ColorIndex = 8
Application.ScreenUpdating = True
End If
End Sub
you place this in ThisWorkbook instead of the specific Sheet.
the code:
If Target.Row <> 1 and Target.Row <> 2 Then
Checks if Target.Row does not equal Row 1 and 2
For example, let's say Cell A1 has a value of 11:37:00 PM (displayed as 23:37). I want to click the cell and immediately advance it to 11:38:00 PM (displayed as 23:38). It's annoying to have to delete and type the new time value into the area on top .
This will enable you to click any cell in column A and add 1 minute. Add this sub to the sheet where you want to add the minutes.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 Then 'edit this to change a different column
Cells(Target.Row, Target.Column).Value = Cells(Target.Row, Target.Column) + TimeValue("00:01:00")
End If
End Sub
Extra
In case you have dates and don't want to update the dates, use this.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 Then 'edit this to change a different column
var = DateValue(Cells(Target.Row, Target.Column).Value)
Cells(Target.Row, Target.Column).Value = Cells(Target.Row, Target.Column) + TimeValue("00:01:00")
var2 = DateValue(Cells(Target.Row, Target.Column).Value)
If var <> var2 Then
Cells(Target.Row, Target.Column).Value = Cells(Target.Row, Target.Column).Value - 1
End If
End If
End Sub