|
Combine 2 worksheet event change codes
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 |
Combine 2 worksheet event change codes
Hi Winnie
Change the statement to: Range("D" & Rchange, Range("F" & Rchange)).Value = vbNullString Regards, Per "winnie123" skrev i meddelelsen ... 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 |
Combine 2 worksheet event change codes
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 |
Combine 2 worksheet event change codes
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 "winnie123" skrev i meddelelsen ... 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 |
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 |
Combine 2 worksheet event change codes
Hi Per, Thankyou very much. Best Regards Winnie "Per Jessen" wrote: 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 |
| All times are GMT +1. The time now is 12:35 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com