Combine 2 worksheet event change codes
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:
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?
"winnie123" wrote:
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
|