PDA

View Full Version : Solved: Call Subroutine to Clear cells on Worksheet_Change



MDY
02-13-2007, 09:37 PM
Hi All,
I'm trying to get my worksheet to clear dependent cells if the contents of a particular cell changes using subroutines. Unfortunately at the moment I am getting the error as attached. It would be greatly appreciated if someone had a solution to my problem. Please see my code below:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address <> "" Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Column = "" Then

'Select Subroutine Targets

If Target = "$Y$4" Then SEWERY4 Target

If Target = "$H$4" Then SEWERH4 Target
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub



'Code to blank fields when a validation field is reset for Sewer main details
Sub Worksheet_Change(ByVal Target As Range)
'Don't run the code unless the change occurs in cell H4
If Target.Address <> "$H$4" Then Exit Sub

'Don't run the code if the change (in H4) is clearing contents
If Target = "" Then Exit Sub

'Blank B2, select B2, show B2 data validation options
Range("L4") = ""
Range("M4") = ""
Range("O4") = ""

End Sub




'Code to blank fields when a validation field is reset for Sewer manhole details
Sub SEWERY4(ByVal Target As Range)
'Don't run the code unless the change occurs in cell Y4
If Target.Address <> "$Y$4" Then Exit Sub

'Don't run the code if the change (in Y4) is clearing contents
If Target = "" Then Exit Sub

'Blank B2, select B2, show B2 data validation options
Range("AF4") = ""
Range("AG4") = ""
Range("AH4") = ""
Range("AI4") = ""
Range("AJ4") = ""
Range("AK4") = ""

End Sub


Another option was to use the code as follows but I could not work out how to repeat the code for the rest of the range. This is much simpler but the code will only work for the first cell H4 or Y4 then stop it will not continue on for $H$5, $H$6, & $Y$5, $Y$6, etc:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$H$4" Then

Range("L4") = ""
Range("M4") = ""
Range("O4") = ""
End If
If Target.Address = "$Y$4" Then

Range("AF4") = ""
Range("AG4") = ""
Range("AH4") = ""
End If

If Target = "" Then Exit Sub

End Sub


Thanks for your help!!!

MDY

JimmyTheHand
02-13-2007, 11:31 PM
Hi MDY :hi:

Wolcome to VBAX!

I'm not sure what
show B2 data validation options means, but I think this code below does what yours was meant to accomplish.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False

Select Case Target.Address
Case "$H$4"
Range("L4:O4").ClearContents
Case "$Y$4"
Range("AF4:AK4").ClearContents
End Select
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub


As for the error essage, I guess you might have a module named SEWERY4 or SEWERH4?

Also, it's not clear what this is about

the code will only work for the first cell H4 or Y4 then stop it will not continue on for $H$5, $H$6, & $Y$5, $Y$6,
Jimmy

EDIT:
Inserted a new line to prevent an error when more than 1 cell is changed:
If Target.Cells.Count > 1 Then Exit Sub

MDY
02-14-2007, 03:27 PM
Gday Jimmy,
Thanks so much for the reply mate, i'm only new to all this so if you have any suggestions feel free to let me know.

Your code is great and very simple to use but there are still some problems.


the code will only work for the first cell H4 or Y4 then stop it will not continue on for $H$5, $H$6, & $Y$5, $Y$6,

Sorry but I was trying to say: one of the biggest problems that I have with the code is that it will only work for Row:4 on my spread sheet where the cells need to change. The code needs to continue on for the whole range eg: H4:H100 and Y4:Y100. With that the corresponding cells should also be cleared are stipulated by ".ClearContents".

More like this but I am sure there is a better way to continue on for the rest of the Range for both Columns H and Y:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False

Select Case Target.Address
Case "$H$4"
Range("L4:O4").ClearContents
Case "$H$5"
Range("L5:O5").ClearContents
Case "$H$6"
Range("L6:O6").ClearContents


'after H6 continue on until the end of Range eg H100


Case "$Y$4"
Range("AF4:AK4").ClearContents
Case "$Y$5"
Range("AF5:AK5").ClearContents
Case "$Y$6"
Range("AF6:AK6").ClearContents
Case "$Y$7"
Range("AF7:AK7").ClearContents


'after Y7 continue on until the end of Range eg H100

End Select
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Thanks heaps,

Cheers!:think:

mdmackillop
02-14-2007, 04:21 PM
Try the following. BTW, as there is a single event, there is in no real benefit in turning off/on screen updating.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub

Application.ScreenUpdating = False
Application.EnableEvents = False

If Not Intersect(Target, Range("H4:H100")) Is Nothing Then
Target.Offset(, 4).Resize(, 4).ClearContents
GoTo Exits
End If

If Not Intersect(Target, Range("Y4:Y100")) Is Nothing Then
Target.Offset(, 7).Resize(, 6).ClearContents
End If

Exits:

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

lucas
02-14-2007, 05:35 PM
Hi Malcolm,
What am I missing here?
If Target.Cells.Count > 1 Then Exit Sub
and then this line...
If Not Intersect(Target, Range("H4:H100")) Is Nothing Then
Target.Offset(, 4).Resize(, 4).ClearContents
if I comment out the first line above it clears col L on that row if there is data in column H.

lucas
02-14-2007, 06:02 PM
I finally sorted it Malcolm....sorry for the confusion. The cell needs to be empty to begin with...

MDY
02-14-2007, 09:02 PM
Hi (Once Again),
Thanks so much everyone for taking interest in this thread!
We are nearly there and some of the coding is fantastic but not quite what I am after. I was wondering if it was possible to use actual cell references instead of the "offset" and "resize" function. It is much easier to work with actual cell references rather than the "Offset" function. This same formula will be applied to many sheets where I have used validation options and want the values to change if the original cell is changed which makes cell references easier. In other sheets the offsets may be different and the resize function may not be able to be used because the formula may relate to H6, H10 and H15. I am aware that the offset may be written as:

If Not Intersect(Target, Range("H4:H100")) Is Nothing Then
Target.Offset(, 4).ClearContents
Target.Offset(, 10).ClearContents
Target.Offset(, 12).ClearContents
GoTo Exits
End If

But it would be much better if the cells could be referenced as H4, H10 and H12 or whatever etc. I hope I have not caused to much confusion.

I have included a sample of my spreadsheet which I believe also has a simple solution to the problems that people often have with cell validation. This is show in the hidden cells and the validation fields reference these. I hope it is useful for someone! Essentially the hidden cells are given the value =(Cell+num). The validation fields then look for this particular name range. Your appropriate named ranges must equal the same as the hidden cells. If you have any more queries regarding this fell free to let me know.

Once this thread is solved how do I mark it off?

Thanks for everyones patience in solving this problem.

Cheers, MDY

JimmyTheHand
02-15-2007, 12:32 AM
If Not Intersect(Target, Range("H4:H100")) Is Nothing Then
Target.Offset(, 4).ClearContents
Target.Offset(, 10).ClearContents
Target.Offset(, 12).ClearContents
GoTo Exits
End If

But it would be much better if the cells could be referenced as H4, H10 and H12 or whatever etc. I hope I have not caused to much confusion.

Yeah, this is confusing all right.
Target.Offset(, 4) changes column index by 4 (to the right).
On the other hand, in H4, H10 and H12, it's the row index that is changed. So I'm not sure what you want to accomplish, after all.

My guess is that you want to be able to vary, from sheet to sheet, the range to be emptied, e.g. empty "L4:O4" on one sheet, and empty L4, O4 and R4 on the other, etc.

You can use Target.Row to identify the rowindex of the changed cell. It can then be used to reference cells directly. E.g. the code below does the same as Malcolm's except with direct referencing, using the rowindex as parameter. (I commented out Goto Exits because, at the present state of the code, there's no point in it being there.)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RowIx As Long

If Target.Cells.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub

RowIx = Target.Row
Application.ScreenUpdating = False
Application.EnableEvents = False

If Not Intersect(Target, Range("H4:H100")) Is Nothing Then
Range(Cells(RowIx, 12), Cells(RowIx, 15)).ClearContents
'GoTo Exits
End If

If Not Intersect(Target, Range("Y4:Y100")) Is Nothing Then
Range(Cells(RowIx, 32), Cells(RowIx, 37)).ClearContents
End If

Exits:

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
Also, instead of
Range(Cells(RowIx, 12), Cells(RowIx, 15)).ClearContents you can use
Range("L" & RowIx & ",M" & RowIx & ",N" & RowIx & ",O" & RowIx).ClearContents
and with this string type range reference you can do a lot.
Still, I'm afraid, it's not possible to reference ranges of different shapes and sizes with the same direct addressing. You will have to write a different code for each sheet.

But the task might be solved with SpecialCells method.
For example:
I want to clear cells L4, M4, N4, O4 if H4 is changed.
I want to clear only cells M5 and N5 if H5 is changed.
I want to clear cells L6, M6 and O6 if H6 is changed.
etc.

Planning to use SpecialCells method in the code, I select L4, M4, M4, O4, M5, N5, L6, M6, O6 (i.e. all cells that need to be cleared by code) and give them a conditional formatting. I set some (any) condition, but do not set the format. So no change will be visible on the sheet, but the conditional formatting will be there. Then I use the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Hit As Range

If Target.Cells.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub

Application.ScreenUpdating = False
Application.EnableEvents = False

Set Hit = Nothing
On Error Resume Next
If Not Intersect(Target, Range("H4:H100")) Is Nothing Then
Set Hit = Target.Offset(, 4).Resize(, 4).SpecialCells(xlCellTypeAllFormatConditions)
If Not Hit Is Nothing Then Hit.ClearContents
'GoTo Exits
End If

If Not Intersect(Target, Range("Y4:Y100")) Is Nothing Then
Set Hit = Target.Offset(, 7).Resize(, 6).SpecialCells(xlCellTypeAllFormatConditions)
If Not Hit Is Nothing Then Hit.ClearContents
End If

Exits:

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
where
Target.Offset(, 4).Resize(, 4).SpecialCells(xlCellTypeAllFormatConditions) selects in the intersection of columns (L:O) and the current row only those cells that have conditional format.

Well, I certainly hope I didn't add to the confusion already in the air :)


Jimmy

mdmackillop
02-15-2007, 01:40 AM
If you need to show what's going on, then add some comments.

If you really need multiple configurations, then I suggest you look at a method of storing your sheet/address references in a series of arrays otherwise your code will become unmanageable very quickly.

Jimmy,
I don't see the point in commenting out GoTo Exits. It serves its function and demonstrates that the code should be exited when execution is complete. Why continue to check further scenarios that you know will fail?

JimmyTheHand
02-15-2007, 02:36 AM
Jimmy,
I don't see the point in commenting out GoTo Exits. It serves its function and demonstrates that the code should be exited when execution is complete. Why continue to check further scenarios that you know will fail?
MD,

I was always told that Goto is to be avoided, if possible, because it can have unexpected results, if used carelessly. I was also told that everything can be done without Goto.

But I see your point... Actually, it was the "s" that convinced me of your being right, the "s" after "further scenario". I didn't consider that there might be more than one further cases to check. That would really be a waste of resources.

And now that I think of it, the code becomes more logical by indicating that the execution is finished...

Okay, I defer fully to your wisdom. :bow:

mdmackillop
02-15-2007, 06:16 AM
Hi Jimmy,
I would normally use Exit Sub if applicable, but this code needs to go to the end to reset events etc.

mdmackillop
02-15-2007, 11:50 AM
Here's a code example to use cell addresses. The code goes into ThisWorkbook module.

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Rw As Long, arr()

Application.EnableEvents = False
If Target.Cells.Count > 1 Then Exit Sub
Rw = Target.Row
Select Case Sh.Name
Case "Sheet1"
If Not Intersect(Target, Range("C4:C100")) Is Nothing Then
ReDim arr(2)
arr(0) = Range("H" & Rw & ":" & "L" & Rw).Address
arr(1) = "O4"
arr(2) = "O12"
DoClear ActiveSheet, arr
End If
Case "Sheet2"
If Not Intersect(Target, Range("C4")) Is Nothing Then
ReDim arr(3)
arr(0) = "Q4:T4"
arr(1) = "A1"
arr(2) = "D1"
DoClear Sheets("Sheet1"), arr
End If
End Select
Application.EnableEvents = True
End Sub

Sub DoClear(Sh As Worksheet, ToClear As Variant)
Dim Addr
For Each Addr In ToClear
Sh.Range(Addr).ClearContents
Next
End Sub

MDY
02-18-2007, 06:07 PM
Hi,
Thanks to both of you for all of the replies on this thread. Sorry about all of the confusion but you will be glad to hear that the code provided by Jimmy as below works great and has provided me with a solution! MD i will most likely use some of your code in other spreadsheets and I'm sure it will be very useful. So just one more question, how do I complete the thread as being solved? (I hope this dosen't provide to much confusion) Thanks Everyone

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RowIx As Long

If Target.Cells.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub

RowIx = Target.Row
Application.ScreenUpdating = False
Application.EnableEvents = False

If Not Intersect(Target, Range("H4:H100")) Is Nothing Then
Range("L" & RowIx & ",M" & RowIx & ",N" & RowIx & ",O" & RowIx).ClearContents
'GoTo Exits
End If

If Not Intersect(Target, Range("Y4:Y100")) Is Nothing Then
Range("AF" & RowIx & ",AG" & RowIx & ",AH" & RowIx & ",AI" & RowIx & ",AJ" & RowIx & ", AK" & RowIx).ClearContents
End If

Exits:

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub