I am trying to take the value inside cell I-8 Multiplied by the value inside H-8 and have this new value X, replace the contents of cell I-8.
I am trying to do this with every row starting with 8. (I-9 * H-9 etc)
I am already removing cell's will qty 0 inside column I with the following:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim c As Range
Dim SrchRng
Set SrchRng = Intersect(ActiveSheet.UsedRange, Range("I:I"))
Do
Set c = SrchRng.Find(0, LookIn:=xlValues)
If Not c Is Nothing Then c.EntireRow.Delete
Loop While Not c Is Nothing
End Sub
You actually need a different event for this to work:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 9 And Target.Cells.Count = 1 And Target.Row > 7 Then
Application.EnableEvents = False
If IsNumeric(Target.Value) Then Cells(Target.Row, 2).Value = Target.Value * Target.Offset(0, -1).Value
Application.EnableEvents = True
End If
End Sub
I feel it needs to pointed out however, that simply entering =H8*I8 into B8 will do the same thing.
Related
I'm attempting to have Column K update with last modified date & time of its own row. I got close using the following code, but it modifies everything in the row after it when I only want it to change the Now value in Column K.
Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:J")) Is Nothing Then
Target.Offset(0, 1) = Now
End If
End Sub
I know I have to change the Taege.Offset to something else, but what would that be to not break code/debug. I considered Target.Column, but I'm unsure of how to write the syntax.
Secondly, I'd like it to ignore row 1 & 2. I thought about changing Range("A:J") to Range("A3:J") but that also break/debugs.
All help is welcomed & appreciated.
You can do it like this:
Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
Set rng = Application.Intersect(Target, Me.Range("A:J"))
If Not rng Is Nothing Then
Application.screenupading = False
For Each c In rng.Cells
c.EntireRow.Columns("K").Value = Now
Next c
End If
End Sub
Maybe try something like this
Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
If Not Intersect(Target, Range("A:J")) Is Nothing Then
For Each rng In Target.Rows
If rng.Row > 2 Then
Cells(rng.Row, 11).Value = Now
End If
Next rng
End If
End Sub
Perhaps a better solution would be this
Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
If Target.Column < 11 Then
Application.EnableEvents = False
For Each rng In Target.Rows
If rng.Row > 2 Then: Cells(rng.Row, 11).Value = Now
Next rng
Application.EnableEvents = True
End If
End Sub
A solution with no looping needed
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column < 11 Then ' 11 = K,
Intersect(Range(Cells(3, 11), Cells(WorksheetFunction.Min( _
Target.Rows.CountLarge + Target.Row - 1, Rows.CountLarge), 11)), _
Target.EntireRow).Value = Now
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
I need to copy the contents of a cell in a particular column to another corresponding column on change so the old value is moved. Only wants to work for a particular column.
Private sub Worksheet_Change(ByVal Target As Range)
if Target.Range("L:L") then
'set I cell value = to original L cell value
ActiveCell.Offset(0,-3).Value = ActiveCell.Value
End If
End Sub
This code should do what you want. Please take note of the comments which explain some limitations I have imposed on the action of this procedure. The rule to follow is to not give it more power than it needs to do the job you want it to do.
Private Sub Worksheet_Change(ByVal Target As Range)
' 027
Dim Rng As Range
' don't react if the changed cell is in row 1 or
' if it is more than 1 row below the end of column L
Set Rng = Range(Cells(2, "L"), Cells(Rows.Count, "L").End(xlUp).Offset(1))
If Not Application.Intersect(Target, Rng) Is Nothing Then
With Target
' skip if more than 1 cell was changed
' meaning, exclude paste actions
If .Cells.CountLarge = 1 Then
.Offset(0, -3).Value = .Value
End If
End With
End If
End Sub
This will save the previous value in column I:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim v As Variant
If Target.Count > 1 Then Exit Sub
If Intersect(Range("L:L"), Target) Is Nothing Then Exit Sub
With Application
v = Target.Value
.EnableEvents = False
.Undo
Target.Offset(0, -3).Value = Target.Value
Target.Value = v
.EnableEvents = True
End With
End Sub
EDIT#1:
To update L without triggering the event, use something like:
Sub ScriptThatUpdatesColumn_L()
Application.EnableEvents = False
Range("L5").Value = "just me"
Application.EnableEvents = True
End Sub
Suppose I have a value in cell A1 and everytime the cell value of A1 changes, the cell on b1 counts the change.
I have a code it works just with A1(value)cell and b1(count on change) cell. i would like to apply this function on cell E2:E709 (value) cells and F2:F709 (count on change) cell.
Private Sub Worksheet_Change(ByVal Target As Range)
Static OldVal As Variant
If Target.Address(False, False) = "A1" Then
Application.EnableEvents = False
If Target.Value <> OldVal Then
Target.Offset(, 1).Value = Target.Offset(, 1).Value + 1
OldVal = Target.Value
End If
Application.EnableEvents = True
End If
End Sub
Try code below:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' If change was outside range we are interested in, then quit Sub
If Intersect(Target, Range("E2:E709")) Is Nothing Then Exit Sub
' store reference to cell in F column for simplicity
Dim c As Range: Set c = Target.Offset(0, 1)
' check if cell in F column has any value, if not, then assign it 1
If c.Value = "" Then
c.Value = 1
' else increment it by one
Else
c.Value = c.Value + 1
End If
End Sub
Consider:
Private Sub Worksheet_Change(ByVal Target As Range)
Static OldVal(2 To 709) As Variant
Dim E As Range, F As Range, r As Range, Intersekt As Range
Dim rw As Long
Set E = Range("E2:E709")
Set F = Range("F2:F709")
Set Intersekt = Intersect(E, Target)
If Intersekt Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In Intersekt
rw = r.Row
If r.Value <> OldVal(rw) Then
r.Offset(0, 1).Value = r.Offset(0, 1).Value + 1
OldVal(rw) = r.Value
End If
Next r
Application.EnableEvents = True
End Sub
We use an array for OldVal rather than a single item.We use a (potentially) multi-cell IntersektRange` to facilitate changing more than one cell at a time.
The code below will add contents of A to B and then clear A across the entire column. How do I duplicate this function to have multiple columns with their own targets inside the same sub? Do I have to write a private sub for each?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim T As Range, r As Range
Set T = Intersect(Target, Range("A:A"))
If T Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In T
With r
.Offset(0, 1).Value = .Offset(0, 1).Value + .Value
.ClearContents
End With
Next r
Application.EnableEvents = True
End Sub
Thank you!
Single column:
Try using Select Case with Target.Column to determine what to do based on column that had event. Adding a GetLastRow function, following helpful comment from #AJD, to ensure only looping populated column range.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Columns.Count <> 1 Then Exit Sub
Select Case Target.Column
Case 1
'col A do something
ClearRange Target
Case 2
'col B do something
ClearRange Target
'Etc
End Select
Application.EnableEvents = True
End Sub
Public Sub ClearRange(ByVal T As Range) '<== This works on the basis Target is a single column
Dim r As Range, loopRange As Range, ws As Worksheet
Set ws = ThisWorkbook.Worksheets(T.Parent.Name)
Set loopRange = ws.Range(ws.Cells(1, T.Column), ws.Cells(GetLastRow(ws, T.Column), T.Column))
If loopRange Is Nothing Then Exit Sub
'Debug.Print loopRange.Address
For Each r In loopRange
With r
.Offset(0, 1).Value = .Offset(0, 1).Value + .Value
.ClearContents
End With
Next r
End Sub
Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
With ws
GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row
End With
End Function
tl;dr;
Multi-column:
You can re-write yours as follows. Though I am not sure what happens with multiple columns. Say, columns A:B, simplest case, were Target, does A get looped transfer and added to B, A gets cleared, B gets looped, added to C and B gets cleared? I wasn't really clear so haven't written anything for the inner part. I simply addressed the title of how to add more targets. Happy to update upon clarification.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("A:A")) Is Nothing Then
End If
If Not Intersect(Target, Range("B:B")) Is Nothing Then
End If
Application.EnableEvents = True
End Sub