conflict with code

[Curt]

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

 

[Joel]

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]

This is all in the sheet_change code it is right below this code

 

[Curt]

Sorry I didn't say all was ok till I added the part about blanks
Thanks

 

[Joel]

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]

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

 

[Tom Ogilvy]

So take it out.

--
Regards,
Tom Ogilvy

Sorry I didn't say all was ok till I added the part about blanks
Thanks

 

[Joel]

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