Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Combine 2 worksheet event change codes
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 129
Default 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
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1,533
Default 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

Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 129
Default 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
Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1,533
Default 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

Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5
Default 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
Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 129
Default 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
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
combine change event codes J.W. Aldridge Excel Programming 2 January 20th 07 04:42 PM
Linking worksheet event codes Mr. G. Excel Worksheet Functions 7 July 15th 05 06:15 PM


All times are GMT +1. The time now is 03:10 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement