I'm have an Excel sheet with a table that performs Index/Match formula in VBA and copy the values into the table. The code is as below:
Private Sub worksheet_change(ByVal target As Range)
If Not Intersect(target, Me.ListObjects("ProjectEntry").ListColumns("Asset No").DataBodyRange) Is Nothing Then
With Me.Range("ProjectEntry[Description]")
.Formula = "=IF(ISNA(INDEX(DieMaster,MATCH(B4,DieMaster[Asset No],FALSE),2)),"""",INDEX(DieMaster,MATCH(B4,DieMaster[Asset No],FALSE),2))"
.Value = .Value
End With
End If
End Sub
I found that this code although works, will execute on all cells in the table. Now I want it to only execute in my selected row. Example, if I perform a change in A5, I want the code to execute in row 5 only.
I have tried using Offset as it worked for me in Excel when data is not in a table. Using the code below:
Private Sub worksheet_change(ByVal target As Range)
If Not Intersect(target, Me.ListObjects("ProjectEntry").ListColumns("Asset No").DataBodyRange) Is Nothing Then
With target.Offset(0, 1)
.FormulaR1C1 = "=IF(ISNA(INDEX(DieMaster,MATCH(rc1,DieMaster[Asset No],FALSE),2)),"""",INDEX(DieMaster,MATCH(rc1,DieMaster[Asset No],FALSE),2))"
.Value = .Value
End With
End If
End Sub
However it doesn't seem to work. Does this mean that Offset does not work in table? If not, is there another way?
Whilst using RC2 fixes your problem, you are far better off using RC[-1]. If you move the table or insert a column to to the left of it, the code will break using absolute references, but not using relative ones.
You are also better off using the IFERROR() function rather than IF(ISNA()) as it results in a formula that avoids repetition, and is half the length:
With Target.Offset(0, 1)
.FormulaR1C1 = "=IFERROR(INDEX(DieMaster,MATCH(RC[-1],DieMaster[Asset No],0),2),"""")"
.Value = .Value
End With
However, the best way to refresh the edited row only, is to do the calculations in VBA and write the results to the sheet.
The following code does this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("ProjectEntry[Asset No]")) Is Nothing Then Exit Sub
Dim Ä As Excel.Application: Set Ä = Excel.Application
Dim varValue As Variant
With Ä.Range("DieMaster").ListObject.ListColumns
varValue = Ä.Index(.Item(2).DataBodyRange, Ä.Match(Target.Value2, Ä.Range("DieMaster[Asset No]"), 0))
End With
Target.Offset(0, 1).Value = IIf(IsError(varValue), vbNullString, varValue)
End Sub
Note the usage of Application. instead of WorksheetFunction. to access the worksheet functions. This, coupled with the use of a Variant type variable, allows us to trap the error that occurs when the match fails.
Related
Hi I have a spreadsheet similar to below
Where when I click on a cell (red cell), I want to return the row and column number to another cell for use in an indirect lookup (blue cell)
Ideally I want to only update the cell value if it's within a set range or at least limit it only to that worksheet for error handling.
Hope that's clear... not an easy thing to google. My experiments with
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
MsgBox ActiveCell.Row
End Sub
Have returned nothing, not even a message box even though macros run fine. Any ideas?
Based on your example. Make sure your code is in the appropriate sheet module, not a standard module and make sure Application.EnableEvents=True (your existing code should have done something).
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Intersect(Target(1), Range("C4:H9")) Is Nothing Then Exit Sub
Range("J3").Value = Cells(Target(1).Row, 2) & "," & Cells(3, Target(1).Column)
End Sub
Use this in the worksheet's private code sheet.
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target.Cells(1), Range("C4:H9")) Is Nothing Then
Range("C4:H9").Interior.Pattern = xlNone
Cells(3, "J") = Join(Array(Cells(Target.Cells(1).Row, "B"), _
Cells(3, Target.Cells(1).Column)), Chr(44))
Target.Cells(1).Interior.ColorIndex = 3
End If
End Sub
I once built a VBA button to automatically lock all cells with data in them. And it was working perfectly. Now I wanted to copy that button to another worksheet. So I created another button, copy and pasted the whole VBA over, then edited the worksheet names and range. And, it's only working like 5% of the time, the rest of the time, I'm getting an "Run-Time error '1004': No cells were found." I've tried a few fixed, changing Sheets to Worksheets, or adding a ", 23" to the specialcells argument. However, nothing is working right now. When I try stepping in, it sometimes say both rng and lckrng as empty, and sometimes only show lockrng as empty and not show rng at all. Problem is this used to be a working code, and now, it still works around 5% of time. Any idea why? Thank you very much!
Private Sub CommandButton1_Click()
Dim rng As Range
Dim lockrng As Range
Sheets("Uploading Checklist (M)").Unprotect Password:="signature"
Set rng = Range("A1:M14")
'Selecting hardcoded data and formulas
Set lockrng = Union(rng.SpecialCells(xlCellTypeConstants), rng.SpecialCells(xlCellTypeFormulas))
lockrng.Locked = True
Sheets("Uploading Checklist (M)").Protect Password:="signature"
End Sub
Maybe this is too simplistic, but it seems to do what you want. The animated .gif shows it working to "lock all cells with data in them". (I made the second button just for convenience). If nothing else it might be good to start from something like this that works and modify to suit your needs.
Dim cell As Range, sh As Worksheet
Sub Button4_Click()
Set sh = Worksheets("Sheet1")
sh.Unprotect Password:="s"
For Each cell In sh.UsedRange
If cell <> "" Then cell.Locked = True Else cell.Locked = False
Next
sh.Protect Password:="s"
End Sub
Sub Button5_Click()
Set sh = Worksheets("Sheet1")
sh.Unprotect Password:="s"
End Sub
The Union you are attempting will not work if either of the parameters is Nothing (i.e. you either have no constants in the range, or you have no formulas in the range).
Prior to doing the Union, you should check the parameters aren't Nothing but, once you start changing your code to do that, it would be just as simple to do the locking in two parts - so I recommend you rewrite the code as follows:
Private Sub CommandButton1_Click()
With Sheets("Uploading Checklist (M)")
.Unprotect Password:="signature"
With .Range("A1:M14")
'Lock any constants
If Not .SpecialCells(xlCellTypeConstants) Is Nothing Then
.SpecialCells(xlCellTypeConstants).Locked = True
End If
'Lock any formulas
If Not .SpecialCells(xlCellTypeFormulas) Is Nothing Then
.SpecialCells(xlCellTypeFormulas).Locked = True
End If
End With
.Protect Password:="signature"
End With
End Sub
I have a cell which I want to record the time when adjacent cells to the left are changed. I do it with the NOW() function; however, the problem is that the time gets updated each time workbook is re-calculated. So, I am wondering whether there is any original way to prevent this very cell from auto-updating.
My current formula in the cell:
=IF(ISBLANK(H11),"",IF(H11="Interested",NOW(),IF(H11="Not Interested",NOW(),"")))
I personally have come up with this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Destination As Range
If Not Intersect(Target, Range("H:H")) Is Nothing Then
Target.Offset(0, 1).Value = Now
End If
End Sub
My issue with this code is that it is looking for any data in the cell. I am only wanting the cell to record the time when it contains either "Interested" or "Not Interested". The cell that I am looking at currently contains "In-progress". I have tried playing around with my code to try and incorporate these criteria's but I keep getting hit with errors. Any advice on what I can do to fix this? Thanks in advance.
Try the following code instead:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Destination As Range
If Not Intersect(Target, Range("H:H")) Is Nothing Then
If LCase(Trim(Target.Value2)) = "not interested" Or LCase(Trim(Target.Value)) = "interested" Then
Application.EnableEvents = False
Target.Offset(0, 1).Value = Now
Application.EnableEvents = True
End If
End If
End Sub
An alternative approach is a simple UDF that you use as =TimeChanged(H11)
Option Explicit
Option Compare Text
Public Function TimeChanged(theCell As Variant)
If TypeOf theCell Is Range Then theCell = theCell.Value2
If theCell = "Interested" Or theCell = "Not Interested" Then
TimeChanged = Now
Else
TimeChanged = ""
End If
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Range = Range("A1") Then
If Range("A1").Value <> Range("A2").Value Then
Range("C1").Value = Range("C1").Value + 1
Range("A2").Value = Range("A1").Value
End If
End If
End Sub
that's the code however when i copy paste a set off cell, let's say 2 columns and 3 rows
it produce runtime error 13 type mismatch on line
If Target.Range = Range("A1") Then
why?
i simply wants the vba to do something everytime cell A1 changes
the value of A1 itself is an excel sum formula
You get type-missmatch error, becase you're trying to compare range (containing many cells) with single cell. If you want to do something every time cell A1 changed, use this one instead:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo ErrHandler
If Not Intersect(Target, Range("A1")) Is Nothing Then
If Range("A1").Value <> Range("A2").Value Then
Range("C1").Value = Range("C1").Value + 1
Range("A2").Value = Range("A1").Value
End If
End If
ExitHere:
Application.EnableEvents = True
Exit Sub
ErrHandler:
Resume ExitHere
End Sub
also note that I'm using Application.EnableEvents = False - it's a good habbit for Worksheet_Change event to use it. It prevents code from infinity firing itself each time you change any cell in event handler code.
UPD:
Btw, the value of A1 itself is an excel sum formula - you can't track changes of formula using above approach. I covered in details how you can do it in this question: Using Worksheet_Calculate event for tracking changes of formula
Simoco's answer should work for you. Another way (the one I usually use, though only out of habit) is to compare the addresses:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("A1").Address Then
If Range("A1").Value <> Range("A2").Value Then
Range("C1").Value = Range("C1").Value + 1
Range("A2").Value = Range("A1").Value
End If
End If
End Sub
You are getting an error because Target.Range is not defined. You should either just refer to Target (a Range Object) or Target.Address (the address of the Range Object). Secondly, depending on the context, Range("A1") refers to either the cell A1 itself (a Range Object) or the value in cell A1 (a literal value). You need to carefully think what you want to compare to what.
If, as you said, you want the comparison done whenever the value in Range("A1") changes then you should follow Simoco's suggestion.
I have two columns but the codition I would like is to be evaluated from one cell to another.
The first column has cells which have a drop down validation with names, and the second will activate only if a certain name from the adjacent cell is selected.
so far i only found this code but it does not seem to work:
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A1").Value = "Car" Then
Range("B1").Locked = False
Else
Range("B1").Locked = True
End If
End Sub
I would need this code go from (for example) A1:A10 and B1:B10.
I hope I am making sense. If there is a way to do it without VBA, that would be great.
Thanks for the help.
The Target parameter tells you the range that is being changed.
You need to do something like the following:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Range("A1:A10"), Target)
If rng Is Nothing Then
' Not updating the range we care about
Exit Sub
Else
rng.Offset(0, 1).Locked = ... whatever ...
End If
End Sub
Note that your target range can be more than one cell (e.g. when using copy/paste), so you need to handle and test this case.
Calling Intersect returns you the intersection of the target range and the range you are interested in testing (A1:A10 in this sample).
You can then access the corresponding adjacent cell(s) using .Offset(0,1)
That code snippet works perfectly for me.
Did you place that code in the proper WorkSheet object? It won't work if you just put it into a VBA module. When you are in the Visual Basic Editor, look for a directory on the left side of the screen labeled "Microsoft Excel Objects". In that directory should be a WorkSheet object for every sheet in your file. Double-click on one of these to edit the code for that WorkSheet. This is where your code snippet should go.
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A1").Value = "Car" Then
Range("B1").Locked = False
Me.Unprotect ("password")
Else
Range("B1").Locked = True
Me.Protect ("password")
End If
End Sub
Use Me.Protect so the .Locked method does something. You should probably unlock every other cell though.