I am currently trying to run this VBA code and keep getting the repeated error 'Invalid inside procedure'. Could anyone suggest what part of the code is wrong?
I have attempted to fault find however can not seem to find the root of the problem.
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("C:C"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, -1).ClearContents
Else
With .Offset(0, -1)
.NumberFormat = "dd MMM yyyy"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("G:G"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 12).ClearContents
Else
With .Offset(0, 12)
.NumberFormat = "dd MMM yyyy"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
Option Explicit
Const sCell As String = "G2" ' Source First Cell
Const dCol As Variant = "J" ' Destination Column Id (String or Index)
Dim irg As Range ' Intersect Range
Dim cOffset As Long ' Column Offset
With Range(sCell)
Set irg = Intersect(.Resize(.Worksheet.Rows.Count - .Row + 1), Target)
If irg Is Nothing Then Exit Sub
cOffset = Columns(dCol).Column - .Column
End With
Dim arg As Range ' Current Area of Intersect Range
Dim cel As Range ' Current Cell in Current Area of Intersect Range
For Each arg In irg.Areas
For Each cel In arg.Cells
If Not IsError(cel.Value) Then
cel.Offset(, cOffset).Value = cel.Value
End If
Next cel
Next arg
End Sub ```
Try to declare Option Explicit before any procedure -- not within it.
Related
Having trouble executing both Worksheet_Change events correctly. Image below show my results, when modifying column B, column M does nothing. When modifying column L, column N updates as expected but only on row 2. Every other subsequent change to B or M results in N:2 updating to the current time again.
My desired outcome is that when Col B is updated I record a time stamp in Col M and the same when Col L updates that I get a time stamp in Col N.
Example of Excel Error
My current code is here:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim rng As Range
Dim rng2 As Range
If Not Intersect(Target, Columns("B"), Target.Parent.UsedRange) Is Nothing Then
On Error GoTo Safe_Exit
For Each rng In Intersect(Target, Columns("B"), Target.Parent.UsedRange)
If CBool(Len(rng.Value2)) And Not CBool(Len(rng.Offset(0, 11).Value2)) Then
rng.Offset(0, 11) = Now
ElseIf Not CBool(Len(rng.Value2)) And CBool(Len(rng.Offset(0, 11).Value2)) Then
rng.Offset(0, 11) = vbNullString
End If
Next rng
Application.EnableEvents = True
End If
ElseIf Not Intersect(Target, Columns("L"), Target.Parent.UsedRange) Is Nothing Then
On Error GoTo Safe_Exit
For Each rng2 In Intersect(Target, Columns("L"), Target.Parent.UsedRange)
If CBool(Len(rng2.Value2)) And Not CBool(Len(rng2.Offset(0, 2).Value2)) Then
rng2.Offset(0, 2) = Now
ElseIf Not CBool(Len(rng2.Value2)) And CBool(Len(rng2.Offset(0, 2).Value2)) Then
rng2.Offset(0, 2) = vbNullString
End If
Next rng2
Application.EnableEvents = True
End If
Safe_Exit:
End Sub
Mock-up, untested, change of code to simplify as you're doing the same actions in two spots:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim columnLetter as String
Select Case Target.Column
Case 2 'B
columnLetter = "M"
Case 12 'L
columnLetter = "N"
Case Else
Goto Safe_Exit
End Select
Dim loopRng as Range
For Each loopRng In Range(Cells(Target.Row, Target.Column),Cells(Target.End(xlDown).Row,Target.Column)
If IsEmpty(loopRng) = True And IsEmpty(Cells(loopRng.Row,columnLetter)) = False Then
Cells(loopRng.Row,columnLetter) = Now
ElseIf IsEmpty(loopRng) = False And IsEmpty(Cells(loopRng.Row,columnLetter)) = True Then
Cells(loopRng.Row,columnLetter) = vbNullString
End If
Next loopRng
'Columns(columnLetter).NumberFormat = "yyyy/mm/dd"
Application.EnableEvents = True
Safe_Exit:
Application.EnableEvents = True
End Sub
Note that the IsEmpty() = True is important... when using an If case, you need to specify for each condition, otherwise the implicit detection will fail.
Edit1: Removed Intersect from loop, whereas the range i've listed will need corrected... it at least references a specific range, now.
Edit2: Removing .Offset and working with specific column references in cells().
I tried this version of my original code and it started to work for some reason.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("B"), Target.Parent.UsedRange) Is Nothing Then
On Error GoTo Safe_Exit
Application.EnableEvents = False
Dim rng As Range
For Each rng In Intersect(Target, Columns("B"), Target.Parent.UsedRange)
If CBool(Len(rng.Value2)) And Not CBool(Len(rng.Offset(0, 11).Value2)) Then
rng.Offset(0, 11) = Now
ElseIf Not CBool(Len(rng.Value2)) And CBool(Len(rng.Offset(0, 11).Value2)) Then
rng.Offset(0, 11) = vbNullString
End If
Next rng
End If
If Not Intersect(Target, Columns("L"), Target.Parent.UsedRange) Is Nothing Then
On Error GoTo Safe_Exit
Application.EnableEvents = False
For Each rng In Intersect(Target, Columns("L"), Target.Parent.UsedRange)
If CBool(Len(rng.Value2)) And Not CBool(Len(rng.Offset(0, 2).Value2)) Then
rng.Offset(0, 2) = Now
ElseIf Not CBool(Len(rng.Value2)) And CBool(Len(rng.Offset(0, 2).Value2)) Then
rng.Offset(0, 2) = vbNullString
End If
Next rng
End If
Safe_Exit:
Application.EnableEvents = True
End Sub
I've read through a bunch of similar questions, but I'm honestly not quite understanding the solution. I've changed the code, and essentially seem to have broken it even more.
Expectation: When the data in the E column is changed, the L and M columns will erase themselves. Additionally, if the F column = "DFW" then it will copy/paste the row to the DFW sheet, and then delete and move up the original row from Sheet1.
Current Result: Nothing happening. Before I added the If Nots (which were suggested in previous posts), I would get the functions to work once, but it would have a weird hangtime but work once. After that, I'd have to restart the spreadsheet to get everything to function again.
Bonus: If there is also a way to auto sort based on column N (oldest to newest) and then sub sort based on column A (A to Z). Essentially organize by date, and then those entries organized alphabetically.
Thanks in advance for any help!
Sub Worksheet_Change(ByVal Target As Range)
Dim tbl As ListObject
Dim i As Long
' Exit if more than one cell updated
' If Target.CountLarge > 1 Then Exit Sub
' Check to see if row > 1 and value is "Yes"
' If (Target.Row > 2) And (Target.Value = "DFW") Then
If Not Intersect(Target, Range("F:F")) Is Nothing Then
If Target.Value = "DFW" Then
' Set tbl to new table
Set tbl = Sheets("DFW").ListObjects("Tasks7835")
' Add row
tbl.ListRows.Add , 1
' set i to rowcount of table
i = tbl.ListRows.Count
' copy values
tbl.DataBodyRange(i, 1).Resize(1, 20).Value = Range("A" & Target.Row).Resize(1, 20).Value
Application.EnableEvents = False
' Delete old row
Target.EntireRow.Delete Shift:=xlUp
Application.EnableEvents = True
Exit Sub
End If
' If Target.Cells.Count > 1 Then Exit Sub
' If Intersect(Target, Range("E:E")) Is Nothing Then Exit Sub
If Not Intersect(Target, Range("E:E")) Is Nothing Then
Application.EnableEvents = False
If Target = vbNullString Then
Target.Offset(0, 7) = vbNullString
Target.Offset(0, 8) = vbNullString
Else
Target.Offset(0, 7) = ""
Target.Offset(0, 8) = ""
End If
On Error GoTo 0
End Sub
Try this code:
Option Explicit
Sub Worksheet_Change(ByVal Target As Range)
Dim TCELL As Range
On Error GoTo out
Application.EnableEvents = False
Set TCELL = Intersect(Target, Me.Columns("F"))
If Not TCELL Is Nothing Then
Set TCELL = TCELL(1) ' get only first cell from Target
If UCase(TCELL) = "DFW" Then
ThisWorkbook.Sheets("DFW").ListObjects("Tasks7835") _
.ListRows.Add(, True).Range.Resize(1, 20).Value = _
Me.Range("A" & TCELL.Row).Resize(1, 20).Value
TCELL.EntireRow.Delete
End If
Else
Set TCELL = Intersect(Target, Me.Columns("E"))
If Not TCELL Is Nothing Then
TCELL(1).Offset(0, 7).Resize(, 2) = vbNullString
End If
End If
out:
Application.EnableEvents = True
End Sub
The original code was almost workable. It was missing two End If. Also, Application.EnableEvents = True was omitted from the second part of the procedure. I also removed some redundant commands such as On Error GoTo 0, Target.Offset(0, 7) = "", i = tbl.ListRows.Count. In addition, I introduced a TCELL variable containing one cell (Target can contain multiple cells and in this case throw an error when executing If Target.Value = ... Then)
A Worksheet Change: Backup Before Delete
Option Explicit
Sub Worksheet_Change(ByVal Target As Range)
Const FirstRow As Long = 2
Dim srg As Range
Dim irg As Range
Set srg = Me.Columns("E").Resize(Me.Rows.Count - FirstRow + 1)
Set irg = Intersect(srg, Target)
If Not irg Is Nothing Then
Application.EnableEvents = False
Intersect(irg.EntireRow, Me.Columns("L:M")).ClearContents
Application.EnableEvents = True
Set irg = Nothing
End If
Set srg = Me.Columns("F").Resize(Me.Rows.Count - FirstRow + 1)
Set irg = Intersect(srg, Target)
If Not irg Is Nothing Then
Dim tbl As ListObject
Set tbl = Me.Parent.Worksheets("DFW").ListObjects("Tasks7835")
Dim drg As Range
Dim iCell As Range
Dim lr As ListRow
For Each iCell In irg.Cells
If CStr(iCell.Value) = "DFW" Then
Set lr = tbl.ListRows.Add(, True)
lr.Range.Resize(, 20).Value = iCell.EntireRow.Resize(, 20).Value
If drg Is Nothing Then
Set drg = iCell
Else
Set drg = Union(drg, iCell)
End If
End If
Next iCell
If Not drg Is Nothing Then
Application.EnableEvents = False
drg.EntireRow.Delete xlShiftUp
Application.EnableEvents = True
End If
End If
End Sub
I need to update a cell with the date and time stamp (NOW()) if any cell is updated within any cell before it within that same row.
So update cell "CU" with date and time when any cell from "A-CR" is updated.
I have done some searching but I can only seem to find bits that work if only updating a single cell, I'm looking for if anything changes within that range.
I currently have some Vba which does something similar which will update the adjacent cell with time and date which is required but I also need an overall one for the whole process.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F:F, I:I, L:L, O:O, R:R, U:U, X:X, AA:AA, AB:AB, AE:AE, AH:AH, AK:AK, AN:AN, AQ:AQ, AT:AT, AW:AW, AZ:AZ, BC:BC, BF:BF, BI:BI, BL:BL, BO:BO, BR:BR, BU:BU, BX:BX, CA:CA, CD:CD, CG:CG, CJ:CJ, CM:CM, CP:CP")) Is Nothing Then
On Error GoTo safe_exit
With Application
.EnableEvents = False
.ScreenUpdating = False
Dim trgt As Range, ws1 As Worksheet
'Set ws1 = ThisWorkbook.Worksheets("Info")
For Each trgt In Intersect(Target, Range("F:F, I:I, L:L, O:O, R:R, U:U, X:X, AA:AA, AB:AB, AE:AE, AH:AH, AK:AK, AN:AN, AQ:AQ, AT:AT, AW:AW, AZ:AZ, BC:BC, BF:BF, BI:BI, BL:BL, BO:BO, BR:BR, BU:BU, BX:BX, CA:CA, CD:CD, CG:CG, CJ:CJ, CM:CM, CP:CP"))
If trgt <> vbNullString Then
If UCase(trgt.Value) = "Y" Or UCase(trgt.Value) = "N" Then
Cells(trgt.Row, trgt.Column + 1) = Now()
Cells(trgt.Row, trgt.Column + 2) = Environ("username")
'Select Case trgt.Column
' Case 2 'column B
' Cells(trgt.Row, trgt.Column + 1) = Environ("username")
' Case 4 'column D
' 'do something else
' End Select
Else
trgt = ""
Cells(trgt.Row, trgt.Column + 1) = ""
Cells(trgt.Row, trgt.Column + 2) = ""
End If
End If
Next trgt
'Set ws1 = Nothing
End With
End If
safe_exit:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
This works for me:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Intersect(Target, Me.Range("A" & Target.Row & ":CR" & Target.Row)) Is Nothing Then GoTo SafeExit
Me.Cells(Target.Row, "CU") = Now()
SafeExit:
Application.EnableEvents = True
End Sub
The below code takes care of:
Clearing the time if the row is blank.
Updating the time only if the values really change from the previous value.
Dim oldValue As String
'Change the range below where your data will be
Const RangeString = "A:CR"
'Below variable decides the column in which date will be displayed
'Change the below value to 1 for column A, 2 for B, ... 99 for CU
Const ColumnIndex = 99
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim HorizontalRng As Range
Dim Rng As Range
Dim HorRng As Range
Dim RowHasVal As Boolean
Set WorkRng = Intersect(ActiveSheet.Range(RangeString), Target)
If Not WorkRng Is Nothing Then
If WorkRng.Cells.Count = 1 And WorkRng.Cells(1, 1).Value = oldValue Then
Exit Sub
End If
Application.EnableEvents = False
For Each Rng In WorkRng
Set HorizontalRng = Intersect(ActiveSheet.Range(RangeString), Rows(Rng.Row))
RowHasVal = False
For Each HorRng In HorizontalRng
If Not VBA.IsEmpty(HorRng.Value) Then
RowHasVal = True
Exit For
End If
Next
If Not RowHasVal Then
ActiveSheet.Cells(Rng.Row, ColumnIndex).ClearContents
ElseIf Not VBA.IsEmpty(Rng.Value) Then
ActiveSheet.Cells(Rng.Row, ColumnIndex).Value = Now
ActiveSheet.Cells(Rng.Row, ColumnIndex).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
End If
Next
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, ActiveSheet.Range(RangeString)) Is Nothing Then
If Target.Cells.Count = 1 Then
oldValue = Target.Value
Else
oldValue = ""
End If
End If
End Sub
I am having a problem of an infinite loop which is caused by the code below.
It is caused by changes in column E affecting changes in G and vice-versa constantly triggering Worksheet_Change(ByVal Target As Range)
In the below code I could stop this with a line that tests if the last change was made by the user or by VBA. Is there a way to test this condition?
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E:E")) Is Nothing Then Macro
If Not Intersect(Target, Range("G:G")) Is Nothing Then Macro2
End Sub
Private Sub Macro()
Dim rng As Range
Dim i As Long
Set rng = Range("E1:E10")
For Each cell In rng
If cell.Value <> "" Then
If IsNumeric(cell.Value) Then
cell.Offset(0, 2).Value = cell.Value + cell.Offset(0, 1)
End If
Else
cell.Offset(0, 2).Value = 1
End If
Next
End Sub
Private Sub Macro2()
Dim rng As Range
Dim i As Long
Set rng = Range("G1:G10")
For Each cell In rng
If cell.Value <> "" Then
If IsNumeric(cell.Value) Then
cell.Offset(0, -2).Value = cell.Value - cell.Offset(0, -1)
End If
Else
cell.Offset(0, -2).Value = 1
End If
Next
End Sub
temporarily disable events triggering:
Private Sub Macro()
Dim rng As Range
Dim i As Long
Set rng = Range("E1:E10")
On Error GoTo HandleExit ' assure proper handling of any error
Application.EnableEvents = False 'disable events triggering
For Each cell In rng
If cell.Value <> "" Then
If IsNumeric(cell.Value) Then
cell.Offset(0, 2).Value = cell.Value + cell.Offset(0, 1)
End If
Else
cell.Offset(0, 2).Value = 1
End If
Next
HandleExit:
Application.EnableEvents = True 'enable back events triggering
End Sub
the same with Macro2
EDIT to add a possible refactoring of the code
BTW, your Sub Macro() could be rewritten with no loops and without relying on IsNumeric() function (which is not 100% reliable (e.g. IsNumeric("12.5.3") would return True)
Private Sub Macro()
On Error GoTo HandleExit ' assure proper handling of any error
Application.EnableEvents = False 'disable events triggering
With Range("E1:E10") 'reference your range
If WorksheetFunction.Count(.Cells) > 0 Then ' if any "truly" numeric values in referenced range
With .SpecialCells(xlCellTypeConstants, xlNumbers).Offset(, 2) ' reference referenced range cells with constant numeric content only
.FormulaR1C1 = "=sum(RC[-1]:RC[-2])" ' write needed formula
.Value = .Value ' get rid of the formula
End With
End If
If WorksheetFunction.CountBlank(.Cells) Then .SpecialCells(xlCellTypeBlanks).Offset(, 2).Value = 1 ' if any blank cell in referenced range then fill it with 1"
End With
HandleExit:
Application.EnableEvents = True 'enable back events triggering
End Sub
The code below works fine when I manually update column I. What I need is to know if there is a way to still have this code work when I have column I updated by a formula.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("I3:I30"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, -1).ClearContents
Else
With .Offset(0, -1)
.NumberFormat = "m/d/yy h:mm"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
End Sub
Worksheet_Change does not fire in responce to a formula update.
See Excel help for Worksheet_Change
Occurs when cells on the worksheet are changed by the user or by an external link.
You could maybe achieve what you want with the Worksheet_Calculate event.
Assuming you want to put a time stamp next to the cells when those vall values change, try this (in addition to your Change event).
Note the use of the Static variable to track previous values, since Calculate event does nopt provide a Target parameter like Change does. This method may not be robust enough since Static's get reset if you break vba execution (eg on an unhandled error). If you want it more robust, consider saving previous values on another (hidden) sheet.
Private Sub Worksheet_Calculate()
Dim rng As Range, cl As Range
Static OldData As Variant
Application.EnableEvents = False
Set rng = Me.Range("I3:I30")
If IsEmpty(OldData) Then
OldData = rng.Value
End If
For Each cl In rng.Cells
If Len(cl) = 0 Then
cl.Offset(0, -1).ClearContents
Else
If cl.Value <> OldData(cl.Row - rng.Row + 1, 1) Then
With cl.Offset(0, -1)
.NumberFormat = "m/d/yy h:mm:ss"
.Value = Now
End With
End If
End If
Next
OldData = rng.Value
Application.EnableEvents = True
End Sub
Update
Tested routine on sample sheet, all works as expected
Sample file contains the same code repeated on 25 sheets, and range to time stamp is 10000 rows long.
To avoid repeating the code, use the Workbook_ events. To minimise run time use variant arrays for the loop.
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim rng As Range
Dim NewData As Variant
Dim i As Long
Static OldData As Variant
Application.EnableEvents = False
Set rng = Sh.Range("B2:C10000") ' <-- notice range includes date column
NewData = rng
If IsEmpty(OldData) Then
OldData = rng.Value
End If
For i = LBound(NewData, 1) To UBound(NewData, 1)
If Len(NewData(i, 1)) = 0 And Len(NewData(i, 2)) > 0 Then
rng.Cells(i, 2).ClearContents
Else
If NewData(i, 1) <> OldData(i, 1) Then
With rng.Cells(i, 2)
.NumberFormat = "m/d/yy -- h:mm:ss"
.Value = Now
End With
End If
End If
Next
OldData = rng.Value
Application.EnableEvents = True
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Activate date population on cell change
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Sh.Range("B2:B10000"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
'Populate date and time in column c
With .Offset(0, 1)
.NumberFormat = "mm/dd/yyyy -- hh:mm:ss"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
End Sub