Possible to Lock Range of cells based on another cell's value? - vba

I am using a tracker for testing new changes, and when. If a new change is N/A, I don't want to delete it, I want to disable (and turn gray) all the cells that are available to select the date it was completed. But only in that row. I've tried using the following methods but haven't had luck with any:
Conditional Formatting on the sheet
VBA code that executes when a change is made
Data Validation (think this is possible but am unfamiliar with how this really works)
Here is the code I have:
Private Sub worksheet_change(ByVal Target As Range)
Dim keycells As Range
Set keycells = Range("G:G")
lastcol = CInt(Sheet1.Cells(1,Sheet1.Columns.Count).End(xlToLeft).Column)
If Not Application.Intersect(keycells, Range(Target.Address)) Is Nothing Then
r = Range(Target.Address).Row
MsgBox "There was a change"
If Range(Target.Address).Value = "N/A" Then
MsgBox "we got this far"
Range("H" & r & ":" & Cells(r, lastcol).Address).Locked = True
End If
End If
End Sub
Both message boxes show, but the cells don't lock. So I tried unlocking all cells, then protecting the sheet. Then I set something to "N/A" and get the error "Unable to set the Locked property of the Range Class".
Here is an idea of what my data looks like:
Thanks in advance!

Well, Community has been insisting (for days) that I look at this question, relentlessly pushing it to the top of my "relevant" queue, probably because it's tagged with my top 4 tags, and it doesn't technically have an Answer.
So, sorry Moacir, I'm swiping your "commented answer":
Leave it protected,
do Worksheet.Unprotect,
run your code (and Worksheet.Protect) after that.
More Info:
Microsoft : Worksheet.Protect Method (Excel)
Microsoft : Worksheet.Unprotect Method (Excel)
S.O. : How to protect cells in Excel but allow these to be modified by VBA script

Related

Incorrect target range in Worksheet_Change event

I am an Excel-VBA newcomer and I am trying to write a short piece of code which is triggered by somebody changing the value of cells in a worksheet. It should set the value of the changed cell to zero if it's less than zero. The code looks like this:
Private Sub Worksheet_Change(ByVal Target As Range)
'Debug.Print Target.Address
If Target.Column = 6 Then
For Each Cell In Target.SpecialCells(xlCellTypeConstants, 3)
If Cell.Value < 0 Then
Cell.Value = 0
End If
Next
End If
End Sub
Now what happens is that when I change the value of any cell in column 6, every cell in the sheet containing numbers less than zero is also changed to zero.
I was thinking that the "Target" Object that is created for the Worksheet_Change event handler would only contain the cell/cells changed, and thus my code would only change the value of cells that were modified and triggered the event in the first place.
I tried to help myself by using Debug.Print to output the address of the object. It printed out the address of every cell in the sheet with a value less than zero, so I assume the handler ran several times.
I actually found a workaround for the problem itself but my questions are these: how did I fail in using the Worksheet_Change event and what can I do in the future to not have such problems?
EDIT 1: Updated code with bug fix suggested in comments
EDIT 2: Updated code with error handling to deal with Array Formulae
In answer to your question
[1] how did I fail in using the Worksheet_Change event and [2] what can I do in the future to not have such problems?
Technically you didn't
Nothing for this type of problem, although the following rule helps in general
You are correct in your understanding of the Targetobject. Your code failed because SpecialCells doesn't like a single cell to operate on. Give it one and it expands it to the entire sheet! Give it anything else and it works just fine.
The reason your Debug.Print displays all the cells is that every time your code changes a cell, another change event is triggered. Luckily for you the second one finds a zero so it doesn't trigger another one. The following general rule should help avoid a lot of problems, just not this particular one:
Always surround any code in an event handler that changes any part of the workbook with Application.EnableEvents.
To fix you code so it works, simply remove the SpecialCells method call. Since you are using Cell.Value instead of the highly recommended Cell.Value2 (see here), VBA implicit type converts numbers formatted as text to actual numbers for you. Thus the code works both on numeric and text values.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Debug.Print Target.Address;
Application.EnableEvents = False
For Each Cell In Target '.SpecialCells(xlCellTypeConstants, 3)
If Cell.Column = 6 And Cell.Value < 0 Then
On Error GoTo Error:
Cell.Value = 0
On Error GoTo 0
End If
Next
GoTo ExitSub:
Error:
If Err.Number = 1004 Then ' 1004 -> "You cannot change part of an array."
'Application.Undo ' Uncomment to disallow array entering a negative value formula into/across column 6
MsgBox "A cell could not be zeroed as" & vbCr & "it is part of an array formula.", vbExclamation, "Microsoft Office Excel"
On Error GoTo 0
Else
On Error GoTo 0
Resume
End If
ExitSub:
Application.EnableEvents = True
End Sub
Notes:
- Update 1: Code now correctly deals with multi-cell changes.
- Update 2: Code now traps error 1004 to deal with entering Array Formulae. It can either allow the array formula to be entered resulting in negative values in column 6, or stop the entry altogether.
This works (Updated)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
For Each c In Target
If c.Column = 6 Then If IsNumeric(c) Then If c < 0 Then c = 0
Next c
End Sub
And please, learn and use OPTION EXPLICIT !
I came here looking for a way to stop my worksheet from "flashing" as it ran code to format columns and rows, due to users changing data anywhere in the sheet, including Filters and Sorting.
Aside, from the official answer to the OP's problem, If you're trying to control the Worksheet_Change() event from firing at all (it will still fire but you can bypass it), in circumstances where you want users to change data for example, but not areas around the data, such as fields or labels as part of your VBA system, I use the Target.Row element to determine my limits. Combined with Target.Column, and you can hone-in on specific cells that are free for the user to control.
i.e.
Dim myTopLimit AS Integer
myTopLimit = 6
etc..etc
if Target.Row < myTopLimit and Target.Row > myBottomLimit and Target.Column < myLeftLimit and Target.Column > myRightLimit then
.... code to allow WorkSheet_Change() to do somthing
else
.... code to force WorkSheet_Change() to drop through or no code
End If

copy row to next free row on another spreadsheet on change

First off, I'm a noob when it comes to Macros and VBA, so please forgive me if I don't make sense.
I've got an Excel spreadsheet which is basically a list of users and their mobile phone numbers and some other bits (columns A-K are currently used) and it's ordered by rows.
What I need is a way of copying the whole row if I change a cell. So if I change the username, it copies the whole row of that user to the next blank row on a second sheet.
The purpose of this is to keep an audit trail allowing us to see who's previously used a number etc.
I found this: Copy row to another sheet in excel using VBA which is working as intended, but I can't for the life of me get it to a, copy the cells to the next free row, or b, not overwrite the existing entry.
This is the code I'm using:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Range, rw As Range
For Each a In Selection.Areas
For Each rw In a.Rows
If rw.Row >= 2 Then
rw.EntireRow.Copy Sheet2.Cells(2 + (rw.Row - 2) * 3, 1)
End If
Next rw
Next a
End Sub
I'd really appreciate it if someone could help me customise it.
I'm using Excel 2010 on Win7.
Many thank in advance.
Typically the Intersect method is used to determine if the cell or cells receiving a change involve one or more columns that you are concerned with. You can add additional parameters; in this case, I've .Offset the Worksheet.UsedRange property down one row to make sure that row 1 is not involved.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(1), Me.UsedRange.Offset(1, 0)) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False 'not really necessary in this case but never a bad idea within a Worksheet_Change
Dim a As Range
For Each a In Intersect(Target, Columns(1), Me.UsedRange.Offset(1, 0))
If CBool(Len(a.Value2)) Then _
a.EntireRow.Copy _
Destination:=Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 'not really sure this is the correct destination
Next a
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
I've included a call to disable event handling for the duration of the Worksheet_Change event macro. While this is a critical step when the Worksheet_Change modifies values, it is not really important to incorporate here. However, it does not harm and is already in place in case you want to augment the Worksheet_Change to include something like a timestamp that would change the values on the worksheet.

Excel date formatting error

I'm doing some work on an already done excel program, but I'm very rusty in this area or probably never had done something in this part, I'm very new in VBA so please don't judge me if it's a simple mistake or error the links are in the description.
So I have problem where if I put the confirmation option, for example: in one cell press "1" in the product you have, and in another cell write "S" if you already have the product and it puts you a date of today in another cell.
The problem is when I delete the info that I inserted, and reenter it the date deformats itself becoming smaller and the location on the cell changes too.
I'm going to put the links because, like I said I'm rusty and I can't find where the code of this date comes.
http://www.docdroid.net/12dh4/master-atual-20155.xls.html -->This one is the Excel
http://www.docdroid.net/12dhj/errorphotos.pdf.html --> photos showing error
this is the code of one of the sheets the other ones are almost the same, If you guys see the photos it would help to understand the error itself.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Set rng1 = Intersect(Range("v3:v500"), Target)
If rng1 Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error Resume Next
If rng1.Value <> "" Then
rng1.Offset(0, 2).Value = Now()
Else
rng1.Offset(0, 2).Clear
End If
Application.EnableEvents = True
End Sub
The code would be triggered when you do the changes at column V. You may find the code in the worksheet itself:
it will clear the date if the column V contains no value.
By the way, the date is not getting smaller but it show the date of today in different format. you may check the date format by right click the cell and choose the format cells... option to look at it.

How do you get a UserForm to activate on double click of a cell?

I haven't been able to get this to work for a long time now after trying a lot of different things I've found online.
I am trying to get a UserForm called "UserComment" to open and activate when I double click a cell (within the columns of B-K and and rows starting at 2 down to the last row of data) on a sheet called Open_Orders.
This is the code I have pasted into the Open_Orders sheet area (not a module).
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Lastrow As Integer
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = Open_Orders.Cells(2, 2)
Set rng2 = Open_Orders.Cells(11 & Lastrow)
Set NewRng = .Range(rng1, rng2)
If Not Application.Intersect(Target, Range("NewRng")) Is Nothing Then
Cancel = True
UserComment.Show
End If
End Sub
When I click on a cell I get the error "Compile Error: Invalid of unqualified reference" and it highlights in blue the ".Range" section of where I set NewRng.
Any ideas of what I can do to fix this?
Also, this is a protected sheet with a password "maintenance"...not sure why there was no problem there.
EDIT: I have added the following code as the first line of code and I still get the same error:
Open_Orders.Protect Password:="maintenance", UserInterFaceOnly:=True
EDIT AGAIN: Gary's Student helped in the comments below by changing Range("NewRng") to to just NewRng....however it still doesn't work because it says its protected EVEN THOUGH I have that code above that should allow it to work.
***UPDATE***
For some reason, when I click the first row of data (row 2), it prompts for a password, and if I press cancel, then the correct userform pops up. No idea what is going on.
you need to qualify your .Range(rng1,rng2) with a sheet reference. If you want the range to be the currently active sheet, then remove the . (dot) in front of .Range(rng1,rng2).
I would agree with sous2817 above: it is going to be much easier to unprotect the entire sheet, and then re-protect it when the form unloads. Since you are displaying the form modally, the user cannot interact with the worksheet anyways, so that preserves enough "protection" -- when the form is modally displayed, the user can't edit it. So just unprotect the sheet, then show the form, then re-protect the sheet in the userform's Terminate event handler.
Here are a few additional observations:
This is a problem because you're doing string concatenation:
Set rng2 = Open_Orders.Cells(11 & Lastrow)
The result of 11 & LastRow is not going to be what you expect. If Lastrow is "33" for example, the result of this expression will be 1133 which is an invalid range assignment. There simply is no such thing as Range(11) or Range(1133), etc. (any numeric value like this will fail with the same error). Try this instead:
Set rng2 = Open_Orders.Cells(11, Lastrow)
Likewise, this is not a valid range:
Range("NewRng")
You have a variable called NewRng which is a range object. When you do "NewRng" you're passing a literal string. Unless you actually also have a Name defined on your worksheet like this (highly unlikely), this will always raise an error because it's a non-existent range. Try this instead:
If Not Application.Intersect(Target, NewRng) Is Nothing Then
I suggest you should read here about how to debug your code. Most of your problems are common mistakes that you will be able to resolve on your own.
http://www.cpearson.com/excel/DebuggingVBA.aspx
How about:
Set NewRng = Open_Oders.Range(rng1, rng2)

Referring to Dynamic Named Ranges in VBA

I'm having troubling referring to a Dynamic Name Range in VBA.
My ranges are defined as
=OFFSET(Sheet!$B$2,0,0,COUNTA(Sheet!$B:$B)-1,1)
My code should search one range for all entries in another range, the intention being that any missing entries will be added. So far I have
Sub UpdateSummary()
Dim Cell As Range
Dim rngF As Range
Set rngF = Nothing
' Step through each cell in data range
For Each Cell In Worksheets("Aspect").Range("A_Date")
' search Summary range for current cell value
Set rngF = Worksheets("Summary").Range("Sum_Date").Find(Cell.Value) // Does not work
If rngF Is Nothing Then
' Add date to Summary
End If
Set rngF = Nothing
Next Cell
End Sub
The For loop seems to work ok. However, using the .Find method is giving me an error message.
Application-defined or object-defined error
It does work if I replace the named range with a specific range ($B$2:$B$5000), so it seems to be down to how the named range is being passed.
Any ideas would be appreciated.
Thanks.
The error is almost definitely because Excel can't find a named range Sum_Date that refers to a range on a worksheet named Summary. The most common causes are
Sum_Date refers to a sheet other than Summary. Check the RefersTo property of Sum_Date and make sure nothing is misspelled.
There is not a named range Sum_Date, that is, it's misspelled in the VBA code. Check the spelling of the named range in the Name Manager.
There is an error in the RefersTo formula of Sum_Date. It sounds like you already verified that this isn't the case.
I've had the a similar if not the same problem & here's how I solved it:
I first realized that the method I used to create my named range, using the Name Manager, my named range had a scope of Workbook. This is important because, it doesn't belong to the worksheet, & therefore will not be found there.
So, Worksheets("Summary").Range("Sum_Date") would not work for me.
Since my range belonged to the workbook, the way I was able to find is to use ActiveWorkbook.Names("Sum_Date")
For me I used it to remove the formula from named range that I am using in many places. The huge advantage is that named range is updated only once instead of the formula being called for every cell location that ranged is called. Huge time delay difference!
Public last_Selection As String
Private Sub Worksheet_Change(ByVal Target As Range)
'excel data change detection
If Range(last_Selection).Column = 2 Then
'Disable events, so this only executes once
Application.EnableEvents = False
'This can be done with a complex formula in a cell,
'but this is easily understood
Range("B1").End(xlDown).Select
ActiveWorkbook.Names("last_Entry").Value = ActiveCell.Row
'Re-enable so this routine will execute on the next change
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'constantly store the last cell to know which one was previously edited
last_Selection = Target.Address
End Sub
I know this is a very old thread, but I had the same issue today and I was looking for solution for quite a long time. So maybe this will help someone.
The named "range" defined by the =OFFSET(...) formula is actually a named FORMULA, so in VBA you have to evaluate it first to get the range. E.g.:
Set rgNamedRange = Worksheets("Summary").Evaluate("Sum_Date")
Credits to a guy named "shg" from mrexcel.com, who got me on right track. :)
I have been experimenting with this for a few days and eventually I came up with the following. It may not be the most efficient but it did work for me!
The named range of "OhDear" was set up in the normal way
Dim vItem As Variant
Set vItem = Names("OhDear")
Debug.Print vItem.Name
Worth a try don't you think!
This does not work if instead of using a variant you use something like: Dim Nm as Name: Set Nm = Names("OhDear"). Any variations using 'Nm' failed!!!