Run-Time error '1004' with my VBA for hiding and unhiding rows - vba

I have code for hiding and unhiding rows in my sheet based on changing the value in my dropdown. Every time I change the dropdown I get Run-Time error of '1004'. I had a private Sub before and changed it to a Sub but that doesn't seem to be the solution.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Target.Parent.Range("L6")
If Target.Count > 1 Then Exit Sub
If Intersect(Target, rng) Is Nothing Then Exit Sub
Application.Run "dynamic_hide"
End Sub
Sub dynamic_hide()
If Target.Range = "$S$9:$S$51" Then
If Target.Range = 0 Then Rows("F9:T51").EntireRow.Hidden = True
If Target.Value <> 0 Then Rows("F9:T51").EntireRow.Hidden = False
End If
End Sub

You have a few problems going on here:
First, the default property of a Range object is Value, so Target.Range = "$S$9:$S$51" will always be false. Use Target.Address instead.
Second, don't use Application.Run to call Subs from the same VBProject. Use Call instead.
Third, you've not let the sub dynamic_hide know what Target is since Target is only a parameter of the Worksheet_Change event subroutine. You can solve this by declaring your sub like Sub dynamic_hide(ByVal Target As Range) And then you can use it: Call dynamic_hide(Target)
Lastly, since Target is a range you don't need to use Target.Range since Target is a range so you can simply omit every .Range from Target.Range Target.Parent.Range is fine.

Related

Run Worksheet_Change if multiple defined cells are changes

I have the following code that runs a goalseek if the defined named range "N" changes. However, I want the code to run if any of several cells changes. E.g. "N1", "N2", etc..
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Application.EnableEvents = False
If Target.Address = Range("N").Address Then
'Goalseek for force equilibrium
Range("Delta_F").GoalSeek Goal:=0, ChangingCell:=Range("h_neutral")
End If
Application.EnableEvents = True
End Sub
I tried the following, but it did not work:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Application.EnableEvents = False
If Target.Address = Range("N, N1, N2").Address Then
'Goalseek for force equilibrium
Range("Delta_F").GoalSeek Goal:=0, ChangingCell:=Range("h_neutral")
End If
Application.EnableEvents = True
End Sub
Any help is appreciated. Thanks in advance.
Testing your criteria as a Range is easier than testing the Address as a string.
Building on #Michal's solution, the below will only execute when your changed cell (Target) overlaps (Intersects) with your 3 ranges (Set as the variable TargetRange here). The main difference is the double negative in the test statement which allows you to avoid Exit Sub resulting in moderately cleaner code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TargetRange As Range
Set TargetRange = Union(Range("B3"), Range("G19"), Range("N1"))
If Not Intersect(TargetRange, Target) Is Nothing Then
Application.EnableEvents = False
Range("Delta_F").GoalSeek Goal:=0, ChangingCell:=Range("h_neutral")
Application.EnableEvents = True
End If
End Sub
Your condition can be easily checked with Intersect function:
If Intersect(Range("N"), Target) Is Nothing Then Exit Sub
If Target doesn't lie within your range, it will exit the sub (this condition should be placed as the first command in your Sub).

Check whether a changed cell in a named range excel vba

I just need to monitor changes in a worksheet, not in the whole worksheet, just inside a named range. So if any kind of change occurs in any cell it should check the change occurs in that named range and if so some function has to do.
Here is my code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ir As Boolean
ir = Application.Intersect(Target.Address, Range("bd_main"))
If ir = True Then
MsgBox "change"
End If
End Sub
But it triggers an error saying Type Mismatch in the Application.Intersect function for Target.Address
What I did wrong there which causes such error.
With slight modification, use the code below:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("bd_main")) Is Nothing Then
MsgBox "change"
End If
End Sub

Type Mismatch error when range of data is changed in Excel

I have written a macro to color my cells green if the input is TRUE and red if the input to cell is FALSE.
Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveSheet.Name = "Ribs" Then
If Not Intersect(Target, Range("G2:K200")) Is Nothing Then
If Target = "False" Then
Sheets("Ribs").Range(Target.Address).Style = "Bad"
ElseIf IsNumeric(Target) Then
Sheets("Ribs").Range(Target.Address).Style = "Good"
End If
ElseIf Not Intersect(Target, Range("D2:D200")) Is Nothing Then
RotateRib (Target.Address)
End If
End If
End Sub
Now the problem is that if I change the range value (for example typing TRUE in cell G2 and than drag mouse pointer from bottom right corner of G2 to G10 should copy value TRUE to range G2:G10) raises Type Mismatch error in my macro.
Debugger says the problematic line is If Target = "False" Then.
Is there a workaround the given error? Ignoring the error would probably do the job, but it's not something I'd like to do.
The problem is that you're trying to do an illegal operation. You're asking the compiler to see if the contents of G2:G10 is equal to False - you can see this by adding Debug.Print Target.Address to the top of your code and then making another attempt.
It is possible to do what you want, but you'll need more code. When comparing values, you have to do it cell by cell - you can't compare an entire range at once. Here's a rudimentary example:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If ActiveSheet.Name = "Ribs" Then
For Each c In Target
If Not Intersect(c, Range("G2:K200")) Is Nothing Then
If c.Value = "False" Then
Sheets("Ribs").Range(c.Address).Style = "Bad"
ElseIf IsNumeric(c.Value) Then
Sheets("Ribs").Range(c.Address).Style = "Good"
End If
ElseIf Not Intersect(c, Range("D2:D200")) Is Nothing Then
RotateRib (c.Address)
End If
Next c
End If
End Sub
The principal change is that we're no longer comparing against Target, we're looping through all the individual cell contents (Range objects denoted as c) of Target and comparing against those.
Again, you can verify that this works by trying this code and filling down some values:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
For Each c In Target
Debug.Print c.Address
Next c
End Sub
There's absolutely no need to check the name of active sheet, since Worksheet_Change event fires on the sheet where it's defined.
Rather iterating over each cell in the Target, you could receive the intersection and apply your settings directly.
Don't forget about that Target can contain non-contiguous ranges (accessed by Areas property). My code handles this situation, but can't say the same about RotateRib.
To sum up:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngIntersect As Range, rngArea As Range, cell As Range
Set rngIntersect = Intersect(Target, Range("G2:K200"))
If Not rngIntersect Is Nothing Then
For Each rngArea In rngIntersect.Areas
For Each cell In rngArea
cell.Style = IIf(cell, "Good", "Bad")
Next
Next
End If
Set rngIntersect = Intersect(Target, Range("D2:D200"))
If Not rngIntersect Is Nothing Then RotateRib (rngIntersect)
End Sub

Macro "trigger on cell change" is also triggered when inserting rows

I'm currently using VBA to check when cells in a certain column are changed, so I can call a different macro to sort them. This works wonderfully, except that it also triggers whenever I insert a new row. So using IsEmpty I added a check to see if the cell in question isn't empty. But I'm obviously doing it wrong, since my macro is still called whenever I insert a row. What am I doing wrong?
The VBA that triggers on cell changes:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A:A")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
If Not IsEmpty(KeyCells) Then
Call SortByDate
End If
End If
End Sub
You might filter out row insertions by checking the number of cells that received a change. In the case of a row insertion, this is greater than or equal to the worksheet's columns.count. If you are changing anything on that worksheet use application.enableevents = false before starting to change anything and application.enableevents = true before leaving the sub.
Private Sub Worksheet_Change(ByVal Target As Range)
' exit immediately on row insertion
If Target.CountLarge >= Columns.Count Then Exit Sub
If Not Intersect(Target, Columns(1)) Is Nothing Then
'escape route
On Error GoTo bm_Safe_Exit
'don't declare or Set anything until you know you will need it
'(this isn't really terribly necessary)
Dim KeyCells As Range
Set KeyCells = Range("A:A")
If Application.CountA(KeyCells) Then 'is there ANYTHING in A:A?
Application.EnableEvents = False
Call SortByDate
End If
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
Failing to disable event handling and subsequently changing anything on the worksheet will trigger another change event and the Worksheet_Change event macro will try to run on top of itself.

Selection.Count overflow when selecting all cells

In Excel 2007 I want to prompt a message when a cell (L2) is clicked on. I have a piece of code that works but the problem is that when I select all the cells in the sheet with Ctrl+A I get error number 06: overflow on the line If Selection.Count = 1 Then
Mandatory VBA code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End Sub
Easily fixed:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.CountLarge = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End Sub
Try this:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If InStr(1, CStr(Target.Address), ":") < 1 Then
If Selection.Count = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End If
End Sub
You must change your code as follows. No Error-Traps needed:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Area.Count = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End Sub
If you had 64-bit Excel I would tell you to use CountLarge instead of Count. Excel 2007 only comes in the 32-bit variety so that's not an option for you.
Your problem is that Range.Count returns a Long variable and throws an error if the number of cells is greater than a Long can store.
To get around this, you can do the following:
Use a Decimal data type stored inside a Variant. The combination can count more than the 1,048,576 rows x 16,384 columns of cells in an Excel worksheet.
Count the cells one column at a time to avoid the error with Range.Count.
I wrote a function that does that. Save this function in a regular code module (not a Worksheet or Workbook module) and use it like this:
If CountLarge32(Selection) = 1 Then
Here's the actual function:
Public Function CountLarge32(ByVal rangeOrSelection As Variant) As Variant
Dim target As Excel.Range
On Error Resume Next
Set target = rangeOrSelection
On Error GoTo 0
Dim cnt As Variant
Dim iColumn As Excel.Range
If Not target Is Nothing Then ' parameter -IS- a valid Range
' Use Range.Count on one column at a time to avoid the overflow error
' if counting higher than the limit of the Long data type.
For Each iColumn In target.Columns
cnt = CDec(cnt + iColumn.Cells.Count)
Next iColumn
CountLarge32 = cnt
End If
End Function
This function also avoids the error that occurs if Select is an object (e.g. button, shape, chart, etc.) instead of a cell.