Combine 2 worksheet event change codes

[winnie123]

Hi,

I am having problems combining the 2 codes below into 1.

I thought I would be able to just copy the first code and tag it at the
bottom of the second code, but it does not like the line, error on th Range

Range("D" & Rchange, "E" & Rchange, "F" & Rchange).Value = vbNullString
'clears cells for in this row for cols D to F

Any assistance appreciated



Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rchange As Integer
Rchange = Target.Row ' row number selected
If Rchange > 3 And Rchange < 5 Then ' make sure only applies to rows
18 to 34
If Target.Address = "$B" & "$" & Rchange Then
'MsgBox "Target address changed :" & Target.Address
Range("D" & Rchange, "E" & Rchange, "F" & Rchange).Value =
vbNullString 'clears cells for in this row for cols D to F

End If
Else
End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Range) 'SAS


Dim rng
Dim r As Long
Dim lc As Long
Dim ans As String
Dim rngDV As Range
If Target.Count > 1 Or Target.Column <> 3 Then Exit Sub

Me.Unprotect Password:="psswrd"
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
If Intersect(Target, rngDV) Is Nothing Then
Application.EnableEvents = False
Target = ""
Application.EnableEvents = True


Exit Sub
End If


r = Target.Row
lc = Cells(r, Columns.Count).End(xlToLeft).Column + 1
Application.EnableEvents = False
Cells(r, lc) = Target
Application.EnableEvents = True
If Application.CountIf(Range(Cells(r, "d"), Cells(r, "Q")), Target) > 1 Then
ans = MsgBox("Duplicated, Continue?", vbYesNo)
If ans = vbNo Then
Cells(r, lc) = ""
End If
Target = ""
End If
If Not Application.Intersect(Target,
Range("C4,C7,C10,C13,C16,C19,C22,C25,C28,C31,C34")) _
Is Nothing Then
Selection.ClearContents
End If


Me.Protect Password:="psswrd"

End Sub

Thankyou
Winnie

 

[winnie123]

I have managed to sort this out.But maybe my code can be shortened?

I have chaged the first code to read

If Target.Column = 2 And Target.Row = 4 Then
ChangeData
End If

and created another module for the macro "ChangeData"

Sub ChangeData()

Worksheets("Data Entry").Unprotect Password:="psswrd"

Range("D4:Q4").ClearContents

Worksheets("Data Entry").Protect Password:="psswrd"


End Sub



and then repeated as required as I have 11 rows which need to apply this too
all in steps of 3, from row 4 to row 34

So the next one I have is

If Target.Column = 2 And Target.Row = 7 Then
ChangeData1
End If
Sub ChangeData1()

Worksheets("Data Entry").Unprotect Password:="psswrd"

Range("D7:Q7").ClearContents

Worksheets("Data Entry").Protect Password:="psswrd"


End Sub

Thanks

Can this be shortened?

 

[Per Jessen]

Hi Winnie

Sure it can be shortened. If target.row is in the range 4-34 then call
ChangeData only for every third row.

See my example:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 And Target.Row >= 4 And Target.Row <= 34 Then
If (Target.Row - 1) Mod 3 = 0 Then
Application.EnableEvents = False
ChangeData (Target.Row)
Application.EnableEvents = True
End If
End If
End Sub

Sub ChangeData(TargetRow As Long)
Worksheets("Data Entry").Unprotect Password:="psswrd"
Range("D" & TargetRow & ":Q" & TargetRow).ClearContents
Worksheets("Data Entry").Protect Password:="psswrd"
End Sub

Regards,
Per

 

[Per Jessen]

Hi Winnie

This is a repost of my reply to you, as my first reply through my news
reader (Microsoft Mail), as it is not visible in the microsoft forum (yet)....


Sure it can be shortened. If target.row is in the range 4-34 then call
ChangeData only for every third row.

See my example:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 And Target.Row >= 4 And Target.Row <= 34 Then
If (Target.Row - 1) Mod 3 = 0 Then
Application.EnableEvents = False
ChangeData (Target.Row)
Application.EnableEvents = True
End If
End If
End Sub

Sub ChangeData(TargetRow As Long)
Worksheets("Data Entry").Unprotect Password:="psswrd"
Range("D" & TargetRow & ":Q" & TargetRow).ClearContents
Worksheets("Data Entry").Protect Password:="psswrd"
End Sub

Regards,
Per



"winnie123" skrev:

 

[winnie123]

Hi Per,

Thankyou very much.

Best Regards
Winnie