PDA

View Full Version : Worksheet Change - Target Range & changes to more than one other cell



starsky
07-17-2009, 03:30 AM
Hi,

I'm trying to set up a worksheet so that if a user selects 'Yes' from a drop down box in column D the value 'n/a' will be applied to the next 4 cells (in columns E,F,G,H) in same row row. Otherwise a small drop down list will be created in each of those next 4 cells.

So far I can make this work fine for one Target cell (D7). I would like it to work for all cells in a Target range of "D7:D1000".

With regard to applying changes to 4 offset cells, instead of 1 as below, I've run into problems when I've declared more than one range and tried to execute the code - Excel appears to freeze and there is flickering in the few cells with anything in them.

Any solutions would be wonderful.

Thanks.



Private Sub Worksheet_Change(ByVal Target As Range)

Dim rg1 As Range

Set Target = Range("D7")
Set rg1 = Target.Offset(0, 1)

If Target = "Yes" Then
rg1.Value = "n/a"
Else: With rg1.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$Q$7:$Q$9"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
End Sub

mdmackillop
07-17-2009, 05:54 AM
rg1.Resize(,4).Value = "n/a"

starsky
07-17-2009, 05:59 AM
Ok, I've progressed since my last post. My current code is below. It does what I want it to. However, if a user selects more than one cell in the Target range, eg to delete entries, then a runtime error 13 occurs. Is there a way can I ask the sub to do nothing if the target range is greater than one cell?

Any tidy up tips welcome too.

Thanks

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rg1 As Range
Dim rg2 As Range
Dim rg3 As Range
Dim rg4 As Range

If Target.Row > 6 And Target.Column = 4 Then

Set rg1 = Target.Offset(0, 1)
Set rg2 = Target.Offset(0, 2)
Set rg3 = Target.Offset(0, 3)
Set rg4 = Target.Offset(0, 4)

If Target = "Yes" Then

rg1.Value = "n/a"
rg2.Value = "n/a"
rg3.Value = "n/a"
rg4.Value = "n/a"

Else:
With rg1.ClearContents
End With
With rg2.ClearContents
End With
With rg3.ClearContents
End With
With rg4.ClearContents
End With

With rg1.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$Q$7:$Q$9"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
With rg2.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$Q$7:$Q$9"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
With rg3.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$Q$7:$Q$9"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
With rg4.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$Q$7:$Q$9"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
End If
End Sub

starsky
07-17-2009, 06:08 AM
Great tip mdmackillop, thanks. I've applied it to each instance where I've repeated code for rg1, etc.

mdmackillop
07-17-2009, 06:26 AM
Is there a way can I ask the sub to do nothing if the target range is greater than one cell?

Exactly what you said!

If Target.Cells.Count >1 Then Exit Sub

starsky
07-17-2009, 06:47 AM
Works a treat. Thanks for your help.