I am new to scripting and I am trying to improve a existing Macro. I recorded a macro to remove duplicate and added it in a Main function which calls some other functions, but I am getting this error when I add the macro I recorded:
Run-time error '1004': Unable to set the hidden property of the range class
The code looks like
Private Sub Worksheet_Change(ByVal Target As Range)
Dim changed As Range
Set changed = Intersect(Target, Range("J15"))
If Not changed Is Nothing Then
Range("A48:A136").EntireRow.Hidden = True
Select Case Target.Value
Case "Agriculture"
Range("A48:A96").EntireRow.Hidden = False
Case "Commercial"
Range("A97:A136").EntireRow.Hidden = False
Case "MDP"
Range("A48:A61").EntireRow.Hidden = False
End Select
Range("J15").Select
End If
End Sub
Some possible answers:
You have a comment in one of the selected cells
You have some drawn objects which don't resize with text
Your worksheet is protected
When you set a breakpoint on the first line of the event handler, and then press F8 to step through the macro, I'm assuming it crashes on the line:
Range("A48:A136").EntireRow.Hidden = True
When people say "You have a comment in one of the selected cells", keep in mind that THE COMMENT CAN BE IN A DIFFERENT COLUMN.
If a comment box is over the column you're trying to hide (like if you're hiding every column to the right and you have comments in a completely different column), this is the error you'll get.
If you try to manually hide the column, you'll get a different confusing error which is something along the lines of "hiding this column will push an object off of the sheet."
The comment box a few columns over is the object.
^ This would have saved me about 40 minutes of debugging.
try this :)
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveWorkbook.Unprotect "password_here"
Dim changed As Range
Set changed = Intersect(Target, Range("J15"))
If Not changed Is Nothing Then
Range("A48:A136").EntireRow.Hidden = True
Select Case Target.Value
Case "Agriculture"
Range("A48:A96").EntireRow.Hidden = False
Case "Commercial"
Range("A97:A136").EntireRow.Hidden = False
Case "MDP"
Range("A48:A61").EntireRow.Hidden = False
End Select
Range("J15").Select
End If
ActiveWorkbook.Protect "password_here"
End Sub
This should work for you :)
Related
I use a VBA macro to query a database and build a list of available projects when a workbook is opened using the workbook activate event. I have project numbers and project names that are combined into two separate data validation lists and applied to two cells. The worksheet change event tests for changes in these cells, splits their data validation lists into arrays, and chooses the corresponding project information from the other array. For instance, if I pick a project number, the worksheet change event finds the project number's position in the project number array, and then picks the project's name from the name array based on position.
This works perfectly whenever a value is selected from the drop down, but I run into problems when values outside the list are entered. For instance, if I enter a blank cell I may get the data validation error or I may get a type mismatch when I use match to find the entered value in the array. I have an error handler to handle the type mismatch, but I would like the data validation error to trigger every time instead. Another problem is that Events will sometimes be disabled. This is much more serious because users will not have a way to turn these back on.
On top of this, I cannot figure out where or how this is happening. I can't replicate how the Events are disabled using breaks because duplicating the steps that lead to the events being disabled with breaks in place only leads to my error handler. However, when breaks aren't applied, the error handler will sometimes fail to trigger and the events will be disabled. Since I'm disabling events just before I parse arrays, I'm thinking the worksheet change fails at the Loc=Application.Match(Target.Text, NumArr, 0) - 1 line, but I can't figure out why no error would be triggered. At the very least, I should get a message with the error number and description, and events should be re-enabled.
Can anyone advise on the interaction between worksheet change and data validation? What is the call order here? Any other advice? Anything I'm missing?
ETA: I've Googled this, but I haven't found anything that helps. Everything that comes up is about working the data validation into worksheet change, nothing about the interaction or call order.
ETA #2: After trying the experiment in the answer below (Thanks Gary's Student), this gets a little more odd. If I choose "Retry" and choose the old, default value, I get the old value three times. If I hit delete, I get a space in the message box, but only one message box. Then the cell is left blank. I can put DV into a loop by clicking "Retry" and accepting the space. The DV error will come up until I click cancel. Then I will get a series of empty text message boxes, one for each time I retried the empty cell. If I start off with a listed value, clear the cell with backspace, click "Retry," and try to select another value, the worksheet change event fails at Intersect 3 times. I think the answer below sheds more light on what is going on, but it does bring up more questions also.
Here is the code I have:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NumArr() As String
Dim ProjArr() As String
Dim Loc As Integer
On Error GoTo ErrHandler:
If Target.Address = "$E$4" Then
'Disable events to prevent worksheet change trigger on cell upates
Application.EnableEvents = False
'Parse validation lists to arrays
NumArr = Split(Target.Validation.Formula1, ",")
ProjArr = Split(Target.Offset(1, 0).Validation.Formula1, ",")
'Change error handler
On Error GoTo SpaceHandler:
'Determine project number location in array
Loc = Application.Match(Target.Text, NumArr, 0) - 1
'Change error handler
On Error GoTo ErrHandler:
'Change cell value to corresponding project name based on array location
Target.Offset(1, 0) = ProjArr(Loc)
'Unlock cells to prepare for editing, reset any previously imported codes
Range("C8:G32").Locked = False
'Run revenue code import
RevenueCodeCollector.ImportRevenueCodes
'Re-enable events
Application.EnableEvents = True
End If
If Target.Address = "$E$5" Then
Application.EnableEvents = False
NumArr = Split(Target.Validation.Formula1, ",")
ProjArr = Split(Target.Offset(-1, 0).Validation.Formula1, ",")
Loc = Application.Match(Target.Text, NumArr, 0) - 1
Target.Offset(-1, 0) = ProjArr(Loc)
Range("C8:G32").Locked = False
RevenueCodeCollector.ImportRevenueCodes
Application.EnableEvents = True
End If
Exit Sub
ErrHandler:
MsgBox Err.Number & " " & Err.Description
Application.EnableEvents = True
Exit Sub
SpaceHandler:
MsgBox "Pick a project from the dropdown.", vbOKOnly, "Error"
Application.EnableEvents = True
End Sub
You have a very open-ended question...........not having the time to do a full whitepaper, here is a simple experiment. I use the Event code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A1 As Range, rINT As Range
Set A1 = Range("A1")
Set rINT = Intersect(A1, Target)
If rINT Is Nothing Then Exit Sub
MsgBox A1.Value
End Sub
and in A1, I setup DV as follows:
If I use the drop-down, I get the value entered and I also get the MsgBox. However, if I click on the cell and type some junk what happens is:
the DV alert occurs and I touch the CANCEL Button
I get 2 MsgBox occurrences, each with the original contents rather than the attempted junk !!
I have absolutely no idea why the event is raised since the cell is not actually changed, let alone why the Event is raised twice !! It is almost as if
the event is raised on junk entry, but the DV alarm has precedence, the DV reverse the entry and another event is raised, and finally both events get processed.
Hopefully a person smarter than me will chime in.
With ref to the query, Workaround for the DV and change event is managed.
Public strRange As String
Public bCheck As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
If bCheck Then Exit Sub
MsgBox "Correct Entry!"
strRange = Target.Address
bCheck = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address <> strRange Then bCheck = False
End Sub
http://forum.chandoo.org/threads/multiple-worksheet-change-event-with-data-validation.32750
Im trying to start a macro when someone double-clicks a certain range of cells. The compleet sub I got now is:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
If Not Application.Intersect(Target, Range("F5")) Is Nothing Then
cancel = True
Dim GoogleMapsCheckLink As String
GoogleMapsCheckLink = "https://www.google.nl/maps/place/" + Range("F5").Value + " " + Range("F6").Value + " " + Range("F7").Value
ActiveWorkbook.FollowHyperlink GoogleMapsCheckLink
GoogleMapsCheckYN.Show
End If
If Not Application.Intersect(Target, Range("B52, B61, D52, D61")) Is Nothing Then
cancel = True
macro
End If
End Sub
But whenever I select one of the cells e.g. B52, B61, D52 or D61 I get a compile error with the message:
Compile error:
Wrong number of arguments or invalid property assignment
The word Range is highlighted.
My question is of course what am I doing wrong currently?
EDIT:
After changing Range to
Range("B52, B61, D52, D61")
I get another error:
Run-time error '1004':
Method ' Range' of object'_Worksheet' failed
Btw I also got other macros that are being activated through double clicking a certain cell value and those do work. The error only occurs when I got multiple cells as range...
Worked for me, using Office 2010.
If the Targets are in Sheet1 then make sure the script is in the Sheet1 Module
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("B52, B61, D52, D61")) Is Nothing Then
Cancel = True
Worked = "Yes"
'Calling Macro would go here
Call SomeModule.SomeMarco
Else
Worked = "No"
End If
MsgBox Worked
End Sub
Change your range like this:
Range("B52, B61, D52, D61")
This is now a valid range reference in Excel. The Range method either accepts two references, and then refers to all the cells in between, or accepts a valid range name.
I have an Excel sheet in which I am accepting value from the user when user enter a value a VBA will run which check the data is valid or not and if the data is not valid it will prompt a message saying invalid data. Here is my code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$12" Or Target.Address = "$D$13" Or Target.Address = "$D$14" Or Target.Address = "$D$15" Then
Call Room
End If
End Sub
Room method is
Sub Room()
Dim lastRow As Long
If IsNumeric(Range("i17")) Then
If [I17] < 0 Then
MsgBox "msg "
End If
End If
End Sub
In I17 cell I have a formula
=C6-(D12+(2*D13) + (2*D14) + (3*D15))
My problem is when wrong data is enter in any of the cells (D12, D13, D14, D15) then the cell should be clear automatically after showing prompt message.
How can this be done?
The first thing that you should do is clean up how you check what Target is. It could be multiple cells (Fill Down, paste a range, ...). This is accomplished by intersecting Target with the range you are interested in, and We'll store into a range variable, for later. If there is no overlap, then intersect will return an empty object, which we can test for with is Nothing.
The next thing to note is that odd things (infinite recursion) can happen if we allow the Worksheet_Change event to fire by changing a cell. To prevent this, we will turn off events before calling Room, and turn it back on after we're done.
Next we pass the range that has changed into room, so we can modify it from within that subroutine.
And, finally we modify the affected range after displaying the message. Note that I have used a command to literally clear the cell. Since you are performing calculations based on that data, you might prefer to set it to default value, like 0, using a.value = 0 instead.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Range
Set a = Intersect(Target, Range("D12:D15"))
If Not a Is Nothing Then
Application.EnableEvents = False
Room a
Application.EnableEvents = True
End If
End Sub
Sub Room(a As Range)
Dim lastRow As Long
If IsNumeric(Range("I17")) Then
If Range("I17").Value < 0 Then
MsgBox "msg "
a.ClearContents
End If
End If
End Sub
As a side note, I have a used a bad variable name a, since I don't know what that range represents. You should pick something that describes to future maintainers what is going on.
use this
Private Sub Worksheet_Change(ByVal Target As Range)
Dim t As Range
Set t = Intersect(Target, [D12:D15])
Application.EnableEvents = 0
If Not t Is Nothing Then
Call Room
If [I17] < 0 Then Target.Value = ""
End If
Application.EnableEvents = 1
End Sub
I have tried code that I've found here on stackoverflow, and elsewhere but they aren't working as I think they can. I'll list them below. I'm almost certain this is an easy question.
What I'm trying to do: If in any of the cells in the range A2:A100 there is any text or number whatsoever, then make the worksheet tab red. And I will need to do this on over 20 tabs. This must execute upon opening the workbook, and thus not require manually changing a cell or recalculating.
The problems I've had with other code: As far as I can tell they require editing a cell, and then quickly hitting enter again. I tried SHIFT + F9 to recalculate, but this had no effect, as I think this is only for formulas. Code 1 seems to work albeit with having to manually re-enter text, but no matter what color value, I always get a black tab color.
Code I've tried:
Code 1:
Private Sub Worksheet_Change(ByVal Target As Range)
MyVal = Range("A2:A27").Text
With ActiveSheet.Tab
Select Case MyVal
Case ""
.Color = xlColorIndexNone
Case Else
.ColorIndex = 6
End Select
End With
End Sub
Code 2: This is from a stackoverflow question, although I modified the code slightly to fit my needs. Specifically, if in the set range there are no values to leave the tab color alone, and otherwise to change it to color value 6. But I'm sure I've done something wrong, I'm unfamiliar with VBA coding.
Private Sub Worksheet_Calculate()
If Range("A2:A100").Text = "" Then
ActiveWorkbook.ActiveSheet.Tab.Color = xlColorIndexNone
Else
ActiveWorkbook.ActiveSheet.Tab.Color = 6
End If
End Sub
Thanks for your help!
I posted this on superuser first, but perhaps stackoverflow is more appropriate since it is explicitly programming-related.
Only two things will be able to switch the condition in this statement:
If Range("A2:A100").Text = "" Then
You've already identified both of them, changing the contents of the one of the cells in that range on a worksheet, or a formula in one of those cells recalculating to or from a value of "". As far as event triggers go, if the formula result changes, both the WorkSheet_Calculate and Worksheet_Change events will fire. Of the two, Worksheet_Change is the one to respond to, because WorkSheet_Calculate will only fire if any of the cells in A2:A100 contain a formula. Not if they only contain values - your "Code 2" isn't wrong, the event was just never firing.
The simple solution is to set your tab colors when you open the workbook. That way it doesn't matter if you have to activate a cell in that range and change it - that's only way the value you're testing against is going to change.
I'd do something like this (code in ThisWorkbook):
Option Explicit
Private Sub Workbook_Open()
Dim sheet As Worksheet
For Each sheet In Me.Worksheets
SetTabColor sheet
Next sheet
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Sh.Range("A2:A100")) Is Nothing Then
SetTabColor Sh
End If
End Sub
Private Sub SetTabColor(sheet As Worksheet)
If sheet.Range("A2:A100").Text = vbNullString Then
sheet.Tab.Color = xlColorIndexNone
Else
sheet.Tab.Color = 6
End If
End Sub
EDIT: To test for the presence of specific text, you can do the same thing but need to have the test check every cell in the range you're monitoring.
Private Sub SetTabColor(sheet As Worksheet)
Dim test As Range
For Each test In sheet.Range("A2:A100")
sheet.Tab.Color = xlColorIndexNone
If test.Text = "whatever" Then
sheet.Tab.Color = vbRed
Exit For
End If
Next test
End Sub
Maybe test the len of the trimmed joined string of cells:
Private Sub Worksheet_Calculate()
If Len(Trim(Join(Application.Transpose(Range("A2:A100"))))) = 0 Then
ActiveWorkbook.ActiveSheet.Tab.Color = xlColorIndexNone
Else
ActiveWorkbook.ActiveSheet.Tab.Color = 6
End If
End Sub
This code will fire off every time the sheet calculates though as it is event code, I am not sure if that is what you want? If not then post back and we can drop it into a normal sub for you and make it poll all the sheets to test.
Worksheet_Change function will get called everytime there's change in the target range. You just need to place the code under Worksheet. If you have placed the code in the module or Thisworkbook then it wont work.
Paste the below in Sheet1 of your workbook and check if it works. Of Course you will need to do modification to the below code as I have not written complete code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WatchRange As Range
Dim IntersectRange As Range
Set WatchRange = Range("A1:A20")
Set IntersectRange = Intersect(Target, WatchRange)
If IntersectRange Is Nothing Then
''Here undo tab color
Else
ActiveSheet.Tab.ColorIndex = 6
End If
End Sub
I am trying to replace all of the conditional formatting of a spreadsheet (over 30 formatting rules). I have created a class module (called ConditionalFormatting) that has a series of subs for all the formatting rules, with one sub for each range that needs conditional formatting.
The only way I have thought to do this (open to suggestions) is by having the worksheet_change event call a sub in the ConditionalFormatting class called FormattingSubs which will call the correct sub to perform the formatting.
Here is the code for FormattingSubs:
Public Sub FormattingSubs(target As Range)
'have logic here to call the right sub based on what target.address
'is from the worksheet.change event
Select Case target.Name.Name
Case "head_pouch_lot_number"
Call HeadPouchLotNumber(target)
Case "head_consumed_pouch_lot"
Call HeadConsumedPouchLot(target)
Case "section_one_heading"
Call SectionOneHeading
End Select
End Sub
And here is the code for one of the formatting subs, HeadConsumedPouchLot: (note that the color variables are public constants defined in a separate module)
Public Sub HeadConsumedPouchLot(target As Range)
Dim head_consumed_pouch_lot As Range
Dim ws As Worksheet
Set head_consumed_pouch_lot = ActiveSheet.Range("head_consumed_pouch_lot")
Set ws = target.Worksheet
If target.address <> head_consumed_pouch_lot.address Then
Set target = head_consumed_pouch_lot
End If
With ws.Range(target.address)
If Range("section_one_heading").Value <> "" Then
.Interior.ColorIndex = red
.Font.ColorIndex = yellow
Else
.Interior.ColorIndex = lightgreen
.Font.ColorIndex = black
End If
End With
The problem is that when it goes to actually set the color, it gives me the 1004 error: "Application-defined or object-defined error."
What is wrong with my code?
The problem I figured out was that I needed to unprotect my sheet before I could make any changes to it! Thank you all for helping me look for answers.