I'm fairly new to VBA and looking for any advice on how to manually control the change event for the below.
Column "F" has a Vlookup that returns "Fail" or "0", and rather that having each individual code to hide the row when the single cell in column F changes to 0, I found the below to work the best.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRow As Long
If Target.Column = 6 Then
' Loop through rows 5-160
For myRow = 5 To 160
' Hide row in entry in column F is "0"
Rows(myRow).Hidden = (Cells(myRow, "F") = "0")
Next myRow
End If
End Sub
I have tried to use the below with the event change but it crashes the program and always restarts. Any suggestions would be greatly appreciated.Thanks!
Private Sub Worksheet_Calculate()
Worksheet_Change Range("F:F")
End Sub
This is my version of what you are trying to accomplish. If the values returned by the formulas in F5:F160 change, the changed values are caught by Worksheet_Calculate and only those changed values are processed by Worksheet_Change.
Caveat: This method of capturing changed values from formulas does not work well when volatile functions are in the workbook. Volatile functions include TODAY(), NOW(), OFFSET(...), etc.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F5:F160")) Is Nothing Then
Application.EnableEvents = False
On Error GoTo meh
Dim t As Range
Debug.Print "chg: " & Intersect(Target, Range("F5:F160")).Address(0, 0)
For Each t In Intersect(Target, Range("F5:F160"))
't.EntireRow Hidden = CBool(LCase(t.Value2) = "fail" or t.Value2=0)
t.EntireRow.Hidden = CBool(LCase(t.Value2) = "fail")
Next t
End If
meh:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Calculate()
Static effs As Variant
Dim f As Long, t As Range
If IsEmpty(effs) Then
effs = Range("F1:F160").Value2
For f = 5 To 160
If IsError(effs(f, 1)) Then effs(f, 1) = vbNullString
Next f
Else
For f = 5 To 160
If Not IsError(Cells(f, "F")) Then
If effs(f, 1) <> Cells(f, "F").Value2 Then
If Not t Is Nothing Then
Set t = Union(t, Cells(f, "F"))
Else
Set t = Cells(f, "F")
End If
effs(f, 1) = Cells(f, "F").Value2
End If
End If
Next f
If Not t Is Nothing Then
Debug.Print "calc: " & t.Address(0, 0)
Worksheet_Change t
End If
End If
End Sub
This seems to run well on a test workbook. Additional error and looping control may be necessary in your own situation.
Related
I'm trying to record the value that changes every one minute from cell "B2" into cell "D2". When the values are recorded to "D2" in a row, I want to add the date and time at the same time it recorded into cell "E". Here, below is my code.
Private Sub Worksheet_Calculate()
Application.EnableEvents = False
Me.Range("D" & Me.Rows.Count).End(xlUp).Offset(1).Value = Me.Range("B2").Value
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim targetRng As Range
Dim rng As Range
Dim c As Integer
Set targetRng = Intersect(Application.ActiveSheet.Range("D:C"), Target)
c = 1
If Not targetRng Is Nothing Then
Application.EnableEvents = False
For Each rng In targetRng
If Not VBA.IsEmpty(rng.Value) Then
rng.Offset(0, c).Value = Now
rng.Offset(0, c).NumberFormat = "dd/mm/yyyy, hh:mm:ss AM/PM"
Else
rng.Offset(0, c).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
It seems that every time the value has recorded, the date and time in cell "E" do not appear to work together.
Any solution here?
I recommend creating a seperate Sub that is not directly hit by an event. Rewrite code below for your purposes.
Private Sub Worksheet_Calculate()
SharedSheetEvent()
end sub
Private Sub Worksheet_Change(ByVal Target As Range)
EditingSheet = true
call SharedSheetEvent()
editingsheet = false
end sub
global EditingSheet as bool
public Sub SharedSheetEvent()
if (EditingSheet) Then
do some stuff
else
do some other stuff
end if
end sub
The code below will do what you want. No two procedures are needed but if you don't specify the sheet, meaning you let it work on the ActiveSheet, it would be a bit of a lose cannon.
Private Sub Worksheet_Calculate()
Dim LastRecord As Range ' cell last written to
Dim NewValue As Variant ' current value in B2
Debug.Print "calculate"
With Worksheets("Sheet1") ' change to suit
Set LastRecord = .Cells(.Rows.Count, "D").End(xlUp)
NewValue = .Cells(2, "B").Value
With LastRecord
If .Value <> NewValue Then ' skip if no change
Application.EnableEvents = False
.Offset(1).Value = NewValue
With .Offset(1, 1)
.Value = Now()
.NumberFormat = "dd/mm/yyyy, hh:mm:ss AM/PM"
End With
Application.EnableEvents = True
End If
End With
End With
End Sub
The question is not, however, how the code works but when. I presume that B2 is changed by a program that works on a timer. The change generated by it doesn't trigger the Worksheet's Change event. You did find out, however, that it triggers the Calculate event. That is my presumption and I couldn't test it. If that is so my procedure will solve your problem.
I have programmed a similar thing recently using a timer of my own to trigger running my procedure. It's just a timer that runs at the same interval as the other and checks every minute (for example) if B2 has changed and records the change if there was one. That works. But if your updater triggers the Calculate event that looks like a neater idea.
I have a worksheet with 3 rows and 7 columns (A1:G3).
A and B columns have 6 checkboxes (A1:B3). Boxes in columns A & B are linked to columns C & D respectively. Cells in columns E & F are just replicating columns C & D respectively (live E1 cell is =C1 and F3 cell is =D3).
I want to put a timestamp in cell G for each row when a checkbox is ticked or unticked by using Worksheet_Calculate event in VBA for that sheet.
My code works when used for just 1 row.
Private Sub Worksheet_calculate()
Dim cbX1 As Range
Set cbX1 = Range("A1:F1")
If Not Intersect(cbX1, Range("A1:F1")) Is Nothing Then
Range("G1").Value = Now()
End If
End Sub
I want to combine the code for 3 rows.
Here are 2 variations:
1st one:
Private Sub Worksheet_calculate()
Dim cbX1 As Range
Dim cbX2 As Range
Dim cbX3 As Range
Set cbX1 = Range("A1:F1")
Set cbX2 = Range("A2:F2")
Set cbX3 = Range("A3:F2")
If Not Intersect(cbX1, Range("A1:F1")) Is Nothing Then
Range("G1").Value = Now()
ElseIf Intersect(cbX2, Range("A2:F2")) Is Nothing Then
Range("G2").Value = Now()
ElseIf Intersect(cbX3, Range("A3:F3")) Is Nothing Then
Range("G3").Value = Now()
End If
End Sub
When I combine them with ElseIf like in the code above, a timestamp gets put in only G1, no matter if I tick B1 or C2.
2nd one:
Private Sub Worksheet_calculate()
Dim cbX1 As Range
Dim cbX2 As Range
Dim cbX3 As Range
Set cbX1 = Range("A1:F1")
If Not Intersect(cbX1, Range("A1:F1")) Is Nothing Then
Range("G1").Value = Now()
End If
Set cbX2 = Range("A2:F2")
If Not Intersect(cbX2, Range("A2:F2")) Is Nothing Then
Range("G2").Value = Now()
End If
Set cbX3 = Range("A3:F2")
If Not Intersect(cbX3, Range("A3:F3")) Is Nothing Then
Range("G3").Value = Now()
End If
End Sub
When I combine them by ending each one with End If and start a new If, timestamp gets put in all of the G1, G2 and G3 cells, even if I tick just one of the boxes.
You seem to be confusing Worksheet_Calculate with Worksheet_Change and using Intersect as if one of the arguments was Target (which Worksheet_Calculate does not have).
Intersect(cbX1, Range("A1:F1")) is always not nothing because you are comparing six apples to the same six apples. You might as well ask 'Is 1,2,3,4,5,6 the same as 1,2,3,4,5,6?'.
You need a method of recording the values of your range of formulas from one calculation cycle to the next. Some use a public variable declared outside the Worksheet_calculate sub procedure; personally I prefer a Static variant array declared within the Worksheet_calculate sub.
The problem with these is initial values but this can be accomplished since workbooks undergo a calculation cycle when opened. However, it is not going to register Now in column G the first time you run through a calculation cycle; you already have the workbook open when you paste in the code and it needs one calculation cycle to 'seed' the array containing the previous calculation cycle's values.
Option Explicit
Private Sub Worksheet_Calculate()
Static vals As Variant
If IsEmpty(vals) Then 'could also be IsArray(vals)
vals = Range(Cells(1, "A"), Cells(3, "F")).Value2
Else
Dim i As Long, j As Long
With Range(Cells(1, "A"), Cells(3, "F"))
For i = LBound(vals, 1) To UBound(vals, 1)
For j = LBound(vals, 2) To UBound(vals, 2)
If .Cells(i, j).Value2 <> vals(i, j) Then
Application.EnableEvents = False
.Cells(i, "G") = Now
Application.EnableEvents = True
vals(i, j) = .Cells(i, j).Value2
End If
Next j
Next i
End With
End If
End Sub
I would like to create an indicator column (call it Column A) that I would use to action several functions such as a copy and paste, ClearContents, in other Columns (E,F,Q,R) in VBA.
Theoretically, I would place an 'x' or a '1' in column A which my code would read and then action my other commands. So if there were an x in Column A, Row 14, then my code would copy/paste from (Q,14) to (E,14) for example.
The purpose of this request is to make my code more dynamic, where it is very static such as the example below.
Private Sub CommandButton1_Click()
Range("A9").Select
Do Until IsEmpty(ActiveCell)
Range("E9:E10").Value = Range("I9:I10").Value
ActiveCell.Offset(1, 0).Select
Loop
End Sub
This assumes you want the 'actions' to happen when you enter the indicators into column A.
For this example, '1' is an indicator of Copy and '2' is and indicator of ClearContents.
Place this procedure in the worksheet's code module:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count = 1 Then
Application.EnableEvents = False
CustomActions
Application.EnableEvents = True
End If
End Sub
And place this procedure in a standard code module:
Public Sub CustomActions(Target As Range)
Dim n&
Const INDICATOR_COL = 1
If Target.Column <> INDICATOR_COL Then Exit Sub
n = Target.Row
Select Case Target.Value
Case 1
'copy Q to E
Range("e" & n) = Range("q" & n)
Case 2
'clear Q and R
Range("q" & n, "r" & n).ClearContents
End Select
End Sub
UPDATE
To use a command button to process column A indicators in batch mode do not use the Worksheet_Change() procedure from my original answer.
Instead use this event procedure:
Private Sub CommandButton1_Click()
Dim i&, n&, v
n = [index(a:a,1+max(iferror(match({"*";9E+99},a:a,{-1;1}),1)))].Row
v = [a1].Resize(n)
For i = 1 To n
If Len(v(i, 1)) Then
CustomActions Range("a" & i)
End If
Next
End Sub
I am currently trying to add a script into excel. excuse my terminology, I am not that hot with programming!
I do all of my accounting on excel 2003, and I would like to be able to add the value of say cells f6 to f27 to the cells e6 to e27, respectively. The thing is, I want the value of the "f" column to reset every time.
So far I have found this code, which works if I copy and paste it into VBA. but it only allows me to use it on one row:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = Range("f7").Address Then
Range("e7") = Range("e7") + Range("f7")
Range("f7").ClearContents
End If
Application.EnableEvents = True
End Sub
would somebody be kind enough to explain how I can edit this to do the same through all of my desired cells? I have tried adding Range("f7",[f8],[f9] etc.. but i am really beyond my knowledge.
First, you need to define the range which is supposed to be "caught"; that is, define the range you want to track for changes. I found an example here. Then, simply add the values to the other cell:
Private Sub Worksheet_Change(ByVal Target as Range)
Dim r as Range ' The range you'll track for changes
Set r = Range("F2:F27")
' If the changed cell is not in the tracked range, then exit the procedure
' (in other words, if the intersection between target and r is empty)
If Intersect(Target, r) Is Nothing Then
Exit Sub
Else
' Now, if the changed cell is in the range, then update the required value:
Cells(Target.Row, 5).Value = Cells(Target.Row, 5).Value + Target.Value
' ----------------^
' Column 5 =
' column "E"
' Clear the changed cell
Target.ClearContents
End if
End Sub
Hope this helps
Try this
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
If Intersect(Target, Range("B1:B5,F6:F27")) Then 'U can define any other range
Target.Offset(0, -1) = Target.Offset(0, -1).Value + Target.Value ' Target.Offset(0,-1) refer to cell one column before the changed cell column.
'OR: Cells(Target.row, 5) = Cells(Target.row, 5).Value + Target.Value ' Where the 5 refer to column E
Target.ClearContents
End If
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I have 2 sheets List and Comments.
List is auto updated from another sheet that imports and formats data
I want to keep track of how often we use each object in sheet List by double clicking on the ID cell (Range("List!$B$6:$B$22")) but as the data is always changing the ID's move around.
the Comments which is a list of all possible ID's and its comments but not the imported values would be a good place to store count data and last used date.
Private Sub WorkSheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If InRange(Target, Range("List!$B$6:$B$22")) Then
Set c = Worksheets("Comments").Range("$A$2:$A$500").Find(Target.Value)
If Not c Is Nothing Then
Set c.Offset(0, 1) = c.Offset(0, 1) + 1
Set c.Offset(0, 2) = Date
End If
End If
Cancel = True
End Sub
No need to Set
Private Sub WorkSheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("$B$6:$B$22")) Is Nothing Then
Set c = Worksheets("Comments").Range("$A$2:$A$500").Find(Target.Value)
If Not c Is Nothing Then
c.Offset(0, 1) = c.Offset(0, 1) + 1
c.Offset(0, 2) = Date
End If
End If
Cancel = True
End Sub