![]() |
conflict with code
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 |
conflict with code
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 |
conflict with code
This is all in the sheet_change code it is right below this code
"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 |
conflict with code
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 |
conflict with code
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 |
conflict with code
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 |
conflict with code
So take it out.
-- Regards, Tom Ogilvy "Curt" wrote in message ... 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 |
conflict with code
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 |
All times are GMT +1. The time now is 05:26 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com