I have a workbook with upto 31 sheets,(named (01),(02) etc, Each with the same format as per the screenshot below
I wish to use the following code which I have found(with help from this forum :) ) to place a timestamp in a mirror file (WorkBook2) that will work out the difference from when column B and Column C in workbook 1 is changed.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B:B, C:C"), Target) Is Nothing Then 'add Columns that will be changed to BA:BA and BB:BB
'add error control
On Error GoTo safe_exit
'don't do anything until you know something has to be done
Dim r As Range
Application.EnableEvents = False
For Each r In Intersect(Range("B:B, C:C"), Target) 'i know this would only work on the same sheet
r.Offset(0, 1).Value = Now() 'Need to get this section to populate workbook2
Next r
End If
safe_exit:
Application.EnableEvents = True
End Sub
I know people have asked similar questions and im sorry if this is a duplicate but I really am lost on trying to get this to work.
Edit - Workbook two sheets are named in the same way with just a "t" after ie (01t), (02t) etc
Try this. The code needs to go in the ThisWorkbook module of workbook 1 and you need to add the name of workbook 2.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim r As Range
On Error GoTo safe_exit
Application.EnableEvents = False
For Each r In Target
Select Case r.Column
Case 2, 3, 5, 6, 8, 9, 11, 12 'b c e f h i k l
Workbooks("name of workbook2").Sheets(Sh.Name & "t").Range(r.Address).Value = Now()
End Select
Next r
safe_exit:
Application.EnableEvents = True
End Sub
Related
I'm trying to figure out a way I can do a simple if statement to choose between two different statements in a Worksheet_SelectionChange Sub. If Intersect of one column is selected Then execute some code or if intersect of another column is selected then do some other code, if any other row is selected do nothing. Now unfortunately this isn't working as expected and drops a "Object variable or with block variable not set" error.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim CommentRow As Range
Dim TestRow As Range
Set TestRow = Intersect(Target, Range("J2:J10000"))
Set CommentRow = Intersect(Target, Range("G2:G10000"))
If ActiveCell = "" Then
GoTo Cancel
ElseIf ActiveCell = TestRow Then
GoTo TestRowComment
ElseIf ActiveCell = CommentRow Then
GoTo CommentRowComment
End If
This should be quite simple but I'm really not sure why it drops an error before reaching the Then statement. It worked fine with just one intersect when I only had CommentRow as my single Range adding the second range I'm not able to workout how to make it work.
You can check for the column without intersect:
Option Explicit
Private Const columnComment = 7 'G
Private Const columnTest = 10 'J
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c As Range: Set c = Target.Cells(1, 1)
If c.Row >= 2 Then
Select Case c.Column
Case columnTest 'column J
'call sub for test
Case columnComment
'call sub for comment
End Select
End If
End Sub
```
I have a macro that puts the current time into a cell upon editing any row. my problem is that this macro also executes for row 1 which are the titles. So it ends up changing the title of a column to a time.
The macro works fine but still changes the title. I tried the following:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If ActiveCell.Row = 1 Then Exit Sub
Cells(Target.Row, "I").Value = Now
Application.EnableEvents = True
End Sub
The ActiveCell can change to something else after you edit, so use the Target range rather than the ActiveCell. For example, if I hit {enter} to finish my edit, the ActiveCell is now on row 2 rather than 1.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
With Target
If .Row > 1 Then
Cells(.Row, "I").Value = Now
End If
End With
Application.EnableEvents = True
End Sub
I'm using With syntax to show the same Row you are comparing is the one you are editing. You could still put these on separate lines if you wish.
Also, user Jeeped makes a good point about the Application.EnableEvents = True line. It won't run if the row is 1, so they get turned off indefinitely. Better to test for > 1 and only run your update code on that condition.
If you turn off event handling, provide error control that makes sure that events will be re-enabled.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Safe_Exit
Application.EnableEvents = False
Dim r As Long, rw As Long, rng As Range, newTarget As Range
For Each rng In Target
If rng.Column <> 9 Then
If newTarget Is Nothing Then
Set newTarget = rng
Else
Set newTarget = Union(newTarget, rng)
End If
End If
Next rng
For r = 1 To newTarget.Rows.Count
rw = newTarget.Rows(r).Row
If rw > 1 Then _
Cells(rw, "I").Value = Now
Next r
Safe_Exit:
Application.EnableEvents = True
End Sub
If you are pasting or filling a large number of values then Target is all of the cells that changed. You need to guard against the top row while everything else receives the timestamp. When Target is more than a single cell, you only want to timestamp once per row.
And you don't want to turn off event handling then exit without turning it back on again.
I want to run an Excel VBA code (all it will do is delete specific cells within the same row and I've turned on relative reference so that I can apply the Excel VBA code to all rows, if there's the appropriate "X") based on whether there is an X in a certain cell.
Here's what I've tried so far (the Excel VBA code is just called "Biology"):
If Range("C22").Value = "X" Then
Call macro_Biology
End If
I should add that I'm writing this under VBA section "GetATPLabel". Like I said, total noob, but I think I'm close, so any help is appreciated.
It sounds as if it is important that the Biology (or macro_Biology) macro needs to know which row it is supposed to work on. You can pass this information across to it with a parameter. Example:
Sub start_with_this()
Dim rw As Long, lr As Long
With ActiveSheet
lr = .Cells(Rows.Count, "C").End(xlUp).Row
For rw = 2 To lr
If UCase(.Cells(rw, "C").Value) = "X" Then
Call macro_Biology(rw)
End If
Next rw
End With
End Sub
Sub macro_Biology(r As Long)
' r is the row that was passed in.
' do something with r
End Sub
After initially starting the start_with_this macro, it goes through each cell in column C from row 2 to the last row with anything in it. If it finds an X or an x (case-sensitivity is removed by forcing the cell value to upper case before comparing) then it calls the second macro, macro_Biology and tells it what row to deal with.
Lets assume that Biology() is a sub in a standard module:
Sub Biology()
MsgBox "study biology!"
End Sub
To call this as you want, run:
Sub TestIt()
If Range("C22").Value = "X" Then
Call Biology
End If
End Sub
To call Biology() automatically if the user types an X in cell C22, Insert the following event macro in the worksheet code area:
Private Sub Worksheet_Change(ByVal Target As Range)
Set intrs = Intersect(Target, Range("C22"))
If Not intrs Is Nothing Then
If intrs.Value = "X" Then
Application.EnableEvents = False
Call Biology
Application.EnableEvents = True
End If
End If
End Sub
To call Biology() automatically if a formula gives an X in cell C22, Insert the following event macro in the worksheet code area:
Private Sub Worksheet_Calculate()
If Range("C22").Value = "X" Then
Application.EnableEvents = False
Call Biology
Application.EnableEvents = True
End If
End Sub
Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
This question appears to be off-topic because it lacks sufficient information to diagnose the problem. Describe your problem in more detail or include a minimal example in the question itself.
Closed 8 years ago.
Improve this question
I can't post an image so I wanted to explain my question in more detail.
I have 2 files: The vlookup formulas are in the Destination File. The vlookup values are in the Source File. The Destination File will be closed. The Source File will be opened. In the Source File, I may change 15 cell values. If so, I want the 15 cells in the Destination File (closed workbook) to be highlighted yellow as they contain the vlookups when I open it. I hope this explains what we're trying to solve.
UPDATE
Instead of highlighting the cells, do you know how to insert a comment in each cell whenever the cell value changes? I would like to comment to say, "Changed cell from 20 to 30".
Try this code (may be time consuming for big ranges with formulas):
in Code module (standart module):
Public cVals As New Dictionary
Sub populateDict()
Dim rng As Range, c As Range
With ThisWorkbook.Worksheets("Sheet1")
Set rng = Intersect(.UsedRange, .Range("CP:CV"))
If rng Is Nothing Then Exit Sub
For Each c In rng
cVals(c.Address) = c.Text
Next c
.Calculate
End With
End Sub
in ThisWorkbook module:
Private Sub Workbook_Open()
Application.Calculation = xlCalculationManual
Call populateDict
Application.Calculation = xlCalculationAutomatic
End Sub
in Sheet module:
Private Sub Worksheet_Calculate()
Dim rng As Range, c As Range
Dim rngToColor As Range
On Error GoTo ErrorHandler
Application.EnableEvents = False
'get only used part of the sheet
Set rng = Intersect(Me.UsedRange, Me.Range("CP:CV"))
If rng Is Nothing Then GoTo ExitHere ' if there is no formulas in CP:CV - exit from sub
'reset color for all cells
rng.Interior.Color = xlNone
For Each c In rng
'check if previous value of this cell not equal to current value
If cVals(c.Address) <> c.Text Then
'if so (they're not equal), remember this cell
c.ClearComments
c.AddComment Text:="Changed value from '" & cVals(c.Address) & "' to '" & c.Text & "'"
End If
'store current value of cell in dictionary (with key=cell address)
cVals(c.Address) = c.Text
Next c
ExitHere:
Application.EnableEvents = True
Exit Sub
ErrorHandler:
Resume ExitHere
End Sub
Note that I'm uisng Dictionary object. For working with Dictionary object you should add reference to Microsoft Scripting Runtime library. Go to Tools->References and select Microsoft Scripting Runtime library:
It looks like you want to build something similar to a trading platform to highlight cells linked with RTD formulas. If it is true (or even if you make changes manually), you can achieve your goal by using worksheet_change.
The below procedure looks at cells in columns 12 to 15 (the real-time values that change) and it compares the values in the FmlaRng (which I assume is a fixed range) before the calculate occurs and after. It is important you set your sheet as xlCalculateManual otherwise Excel will calculate the new values before you can record the old ones.
Also, I am not sure if you need to keep the Application.EnableEvents, but I left it there.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim endrow As Long, startrow As Long, i As Long, j As Long
Dim PreValue As Variant
Dim FmlaRng As Range
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
If Target.Column >= 12 And Target.Column <= 15 Then 'This is where the cell initally changes (the lookupvalue cells)
On Error GoTo 0
startrow = 1
endrow = 1000
With Workbooks("Workbook2").sheets("Sheet1") 'You need to change these names
Set FmlaRng = .Range(.Cells(startrow, 94), .Cells(endrow, 100)) 'FmlaRng is where the lookups should be
FmlaRng.Cells.Interior.ColorIndex = 0
PreValue = FmlaRng
Calculate 'This is when vlookups update
For i = LBound(PreValue, 1) To UBound(PreValue, 1)
For j = LBound(PreValue, 2) To UBound(PreValue, 2)
If FmlaRng.Cells(i, j) = PreValue(i, j) Then
Else
FmlaRng.Cells(i, j).Interior.ColorIndex = 36
End If
Next j
Next i
End with
End If
Application.EnableEvents = True
End Sub
I would like to start off with stating that I have virtually no coding experience. I found a VBA snippet online for highlighting an entire selected range (just to as a visual guide):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
' Clear the color of all the cells
Cells.Interior.ColorIndex = 0
With Target
' Highlight the entire column that contain the active cell
.EntireRow.Interior.ColorIndex = 8
End With
Application.ScreenUpdating = True
End Sub
I would like to also have the cursor jump-to column "J". For instance, after performing a search for cells containing the words "strawberry topping" after pressing 'OK' the cell containing that text becomes active and, due to the VBA code, the entire row is highlighted.
The first cell I need to work on is in column "J". Can I also have column J selected along with the row being highlighted?
Thank you so much for your time and would appreciate any help you may have to offer.
My Three cents
If you are using xl2007+ then do not use Target.Cells.Count. Use Target.Cells.CountLarge else you will get an Overflow error if a user tries to select all cells by pressing CTRL + A as Target.Cells.Count can't hold a Long value.
If you want to select the row and the column, you might want to switch off events else you might end up in endless loop.
Since you are working with events, use error handling.
Is this what you are trying?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rw As Long, Col As Long
Dim ColName As String
On Error GoTo Whoa
If Target.Cells.CountLarge > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
' Clear the color of all the cells
'Cells.Interior.ColorIndex = 0
With Target
Rw = .Row
Col = .Column
ColName = Split(Cells(, Col).Address, "$")(1)
' Highlight the entire column that contain the active cell
'.EntireRow.Interior.ColorIndex = 8
Range(ColName & ":" & ColName & "," & Rw & ":" & Rw).Select
End With
LetsContinue:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
End Sub