Curt: there wre two problems with your code
1) The Error handler found an error so the code wasn't executed. I
commented out the On Error to find this problem
from:
Set rng = Range(Range("L:1").Target)
to:
Set rng = Range(Range("L1"), Target)
2) There was problems with nesting of the IF statements. It is a good idea
to always have End IF. when posting code on theis website try to keep the
length of line short enough so they don't wrap
New code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
On Error GoTo errhandler
Application.EnableEvents = False
If Target.Column = 12 And Target.Row > 1 Then
Set rng = Range(Range("L1"), Target)
If rng.Count > 0 Then
If Application.CountBlank(rng) Then
MsgBox "Don't leave any blank cells"
Target.ClearContents
Target.End(xlUp).Offset(1, 0).Select
Application.EnableEvents = True
Exit Sub
End If
End If
If Target.Column = 12 And Target.Value > 10 And _
IsNumeric(Target.Value) Then _
Call CopyDonors(Target)
If Target.Column = 12 And Target.Value > 10 Then
Target.Value = 10
' Target.Value = 10
End If
End If
If Target.Column = 12 And Target.Value <= 0 Then
Call Copycomp(Target)
' End If
End If
Application.EnableEvents = True
Exit Sub
errhandler:
Application.EnableEvents = True
' If Target.Value > 10 Then Target.Value = 10
End Sub
"Curt" wrote:
> copy donors & copycomp all worked right untill I put in blank code then copy
> donors did not copy & paste as before. This had nothing to do with blank
> entry was useing numeric entry The spreadsheet is for entries in a Veteran's
> Day parade. Data is entered as entries come in. I am trying to do this to
> make it easier for operation. At 70 all seem you can do it all. I believe all
> of your suggestions were in this code at one time. What happens is if target
> cell is blank and you hit enter to continue it throws you back to next row.
> cell column b All of this code is in the sheetsection. I started in the
> workbook and moved to sheet as it seemed more appropiate. Here is what I have
> got. Data entry sheet has thru column (A:M) M has no bearing on this data. It
> is moved with data on a sort for parade order. It is description of entry.
> Name address entry person etc.(A:L) L is dollar amount paid This is so we
> know how much is donation and what is entry. Also the comps. The need for
> this blank is so complete data is entered in row. Noticed some of line
> continuation in wrong place from copy. Hope i have not rambled to long
> Don't know what an old dog like me would do without the support you and
> others give.
> Thanks With all My Heart
> Semper Fi
>
> Option Explicit
> Private Sub Worksheet_Change(ByVal Target As Range)
> Dim rng As Range
> On Error GoTo errhandler
> Application.EnableEvents = False
> If Target.Column = 12 And Target.Row > 1 Then
> Set rng = Range(Range("L:1").Target)
> If Application.CountBlank(rng > 0) Then
> MsgBox "Don't leave any blank cells"
> Target.ClearContents
> Target.End(xlUp).Offset(1, 0).Select
> Application.EnableEvents = True
> Exit Sub
> End If
>
> If Target.Column = 12 And Target.Value > 10 And IsNumeric(Target.Value)
> Then _
> Call CopyDonors(Target)
> If Target.Column = 12 And Target.Value > 10 Then Target.Value = 10
> ' Target.Value = 10
> End If
> If Target.Column = (12) And Target.Value <= 0 Then _
> Call Copycomp(Target)
> ' End If
> Application.EnableEvents = True
> Exit Sub
> errhandler:
> Application.EnableEvents = True
> ' If Target.Value > 10 Then Target.Value = 10
> End Sub
>
>
> Public Sub CopyDonors(ByVal Target As Range)
> Dim wksSummary As Worksheet
> Dim rngPaste As Range
> Set wksSummary = Sheets("Donors")
> Set rngPaste = wksSummary.Cells(65536, "A").End(xlUp).Offset(0, 0)
> ' recommend disabling events to block extra passes through
> ' Worksheet_Change caused for changing Donors cells
> Application.EnableEvents = False
> Set rngPaste = rngPaste.Offset(1, 0)
> Range(Target.Offset(0, -7), Target.Offset(0, 0)).Copy _
> Destination:=rngPaste
> rngPaste.Offset(0, 7) = Target - 10
> Application.EnableEvents = True
>
> End Sub
> Public Sub Copycomp(ByVal Target As Range)
> Dim wksSummary As Worksheet
> Dim rngPaste As Range
> Set wksSummary = Sheets("Comp")
> Set rngPaste = wksSummary.Cells(65536, "A").End(xlUp).Offset(0, 0)
> ' recommend disabling events to block extra passes through
> ' Worksheet_Change caused by changing Comp cells
> Application.EnableEvents = False
> Set rngPaste = rngPaste.Offset(1, 0)
> rngPaste = Range(Target.Offset(0, -7), Target.Offset(0, 0))
> Range(Target.Offset(0, -7), Target.Offset(0, 0)).Copy _
> Destination:=rngPaste
> rngPaste.Offset(0, 7) = Target
> Application.EnableEvents = True
> End Sub
>
>
>
>
>
> "Joel" wrote:
>
> > Curt: I have a few questions. See comments below. If this line was added I
> > think thats the problem: target.end(xlup).offset(1,0).Select
> >
> > 1) Can you be more specific abut this statement you said in your last posting.
> > "I didn't say all was ok till I added the part about blanks"
> >
> > Do you mean that it is failing when blanks ae in the cell?
> >
> > This would mean that "IsNumeric(Target.Value)" is true when there is
> > blanks!.
> >
> > 2) Any idea what changed to cause problem. Are you working with a different
> > version of Excel or ws any service packs installed on your PC?
> >
> > 3) I should of been more specific. Can you supply the subroutines
> > CopyDonors(Target) and Copycomp(Target)
> >
> > 4) Lets try to find out if Copydonors is causing the problem. Is the
> > problem occuring when the cell that changed was in column 12 (column L) and
> > the value is less than 0, as well as, in other cases?
> >
> > 5) Let see if we can get the message box to get displayed! Look at the code
> > below
> >
> > set rng = Range(Range("L1"),Target)
> > if Application.Countblank(rng) > 0 then
> > msgbox "Don't leave any blank cells
> >
> > Add a double quote to the end of msgbox line after cells
> >
> > The message box will only occur if it finds blanks in column L1. Leave
> > a blank cell in column L and then add data at a row below the blank cell and
> > see if the message box occurs.
> >
> >
> > 6) This line should move the cursor to the row below where the data was
> > entered in column L. This implies that Copy donors was called and changed
> > the cursor position.
> >
> > target.end(xlup).offset(1,0).Select
> >
> > Is this part of a changed you made? It may be the problem. If you enter
> > data in row 4 below the cursor will move to row 3. Target is set to row 4.
> > The xlup will move the cursor to row two (the last row of data above row 4),
> > then the offset moves the cursor down one row. Then Copy donors is called.
> > Before this line was added the cursor would of been at row 4.
> >
> > row 1 2
> >
> > row 2 3
> >
> > row 3 blank
> >
> > row 4 7
> >
> > ------------------------------------------------------------------------------------
> >
> >
> > "Curt" wrote:
> >
> > > Sorry I didn't say all was ok till I added the part about blanks
> > > Thanks
> > >
> > > "Joel" wrote:
> > >
> > > > Do youhave the CopyDonors functtion. It is probably in a module inthe VBA
> > > > code. the worksheet change function has to be in the sheet code. General
> > > > pupose routines are in modules.
> > > >
> > > > "Curt" wrote:
> > > >
> > > > > Have a conflict with copydonors. When code in place copy donors does not copy
> > > > > as before. Also code when you hit enter on target cell returns you to next
> > > > > line and column 'B' One time it did bring up msg box. anyone have any ideas
> > > > > This old dog needs help
> > > > > Thanks
> > > > > Following is code
> > > > >
> > > > > Private Sub Worksheet_Change(ByVal Target As Range)
> > > > > On Error GoTo errhandler
> > > > > Application.EnableEvents = False
> > > > > If Target.column = 12 and Target.row > 1 then
> > > > > set rng = Range(Range("L1"),Target)
> > > > > if Application.Countblank(rng) > 0 then
> > > > > msgbox "Don't leave any blank cells
> > > > > target.clearcontents
> > > > > target.end(xlup).offset(1,0).Select
> > > > > Application.EnableEvents = True
> > > > > exit sub
> > > > > end if
> > > > >
> > > > > If Target.Column = 12 And _
> > > > > Target.Value > 10 And _
> > > > > IsNumeric(Target.Value) Then
> > > > > Call CopyDonors(Target)
> > > > > Target.Value = 10 '< change the value after calling
> > > > > the sub
> > > > > elseif Target.Column = 12 And _
> > > > > Target.Value <= 0 Then
> > > > > Call Copycomp(Target)
> > > > > end if
> > > > > end if
> > > > > Application.EnableEvents = True
> > > > > Exit Sub
> > > > > errhandler:
> > > > > Application.EnableEvents = True
> > > > > End Sub
> > > > >
> > > > >
|