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
|
Similar Threads
