![]() |
OnTime Change_Event macro AND copy to sheet2 macro trouble
The change event macro is in sheet 1 module.
The TheNameOfMySub macro is in Module 1. (I had the TheNameOfMySub macro just below the change event in sheet 1 module but it produced an error as if the macro it was calling was not available in this workbook...) The results are so varied I am at a loss to try to explain them all. I would appreciate it if you would duplicate a sheet1 and sheet2 with the codes and tell me what I'm doing wrong. The results I expect a If A1:A15 of sheet 1 is changed, then after the time lapses in the change event macro, each cell in A1:A15 will be copied to the first empty cell on sheet 2 of each row. Seems like first copy works ok, but make a change in A1:A15 and next time there is no copy. The sheet "blinks" like the macro was fired but no results. If I go to Module 1 and click on the "Run Macro" icon it copies just fine. There might be some other ghost like stuff that happens sometimes but I've lost track of what they might have been. Thanks, Howard Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Application.OnTime Now + TimeValue("00:00:10"), "TheNameOfMySub" End Sub Sub TheNameOfMySub() Dim c As Range Application.ScreenUpdating = False If Not Range("A1:A15") Is Nothing Then For Each c In Range("A1:A15") c.Copy If Sheets("Sheet1").Range("A" & c.Row).Value = "" Then Sheets("Sheet1").Range("A" & c.Row).PasteSpecial Else Sheets("Sheet2").Cells(c.Row, Sheets("Sheet2").Cells(c.Row, Columns.Count). _ End(xlToLeft).Column + 1).PasteSpecial End If Next Else Exit Sub End If Application.CutCopyMode = False Application.ScreenUpdating = True End Sub |
OnTime Change_Event macro AND copy to sheet2 macro trouble
Howard,
Try changing your _Change event code as follows... Private Sub Worksheet_Change(ByVal Target As Range) 'Only copy if change is within specified range If Not Intersect(Target, Me.Range("A1:A15")) Is Nothing Then Set wksSource = Me Application.OnTime Now + TimeValue("00:00:10"), "TheNameOfMySub" End If End Sub ...and revise your module as follows... Option Explicit Public wksSource As Worksheet, wksTarget As Worksheet Sub TheNameOfMySub() Dim c As Range, lPos As Long Set wksTarget = ThisWorkbook.Sheets("Sheet2") For Each c In wksSource.Range("A1:A15") With wksTarget lPos = .Cells(c.Row, .Columns.Count).End(xlToLeft)(2).Column If Not .Cells(c.Row, lPos) = "" Then lPos = lPos + 1 .Cells(c.Row, lPos) = c.Value End With Next 'Cleanup Set wksSource = Nothing: Set wksTarget = Nothing End Sub ...which does not toggle ScreenUpdating since there's no copy/paste activity! Note that since your code copies every cell in Range("A1:A15") every time, this will not reflect only the changed cells. I suspect you want to only update "Sheet2" with changes and so you might want to put the Target.Address into a public variable so your sub only transfers changed cell contents. -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
OnTime Change_Event macro AND copy to sheet2 macro trouble
If transferring changed cell content only...
Revise the _Change event as follows... Private Sub Worksheet_Change(ByVal Target As Range) 'Only copy if change is within specified range If Not Intersect(Target, Me.Range("A1:A15")) Is Nothing Then Set wksSource = Me: sTargetAddr = Target.Address Application.OnTime Now + TimeValue("00:00:10"), "TheNameOfMySub" End If End Sub ...and update the module code as follows... Public wksSource As Worksheet, wksTarget As Worksheet, sTargetAddr$ Sub TheNameOfMySub() Dim c As Range, lPos As Long Set wksTarget = ThisWorkbook.Sheets("Sheet2") Application.ScreenUpdating = False For Each c In wksSource.Range(sTargetAddr) With wksTarget lPos = .Cells(c.Row, .Columns.Count).End(xlToLeft)(2).Column If Not .Cells(c.Row, lPos) = "" Then lPos = lPos + 1 .Cells(c.Row, lPos) = c.Value End With Next Application.ScreenUpdating = True 'Cleanup Set wksSource = Nothing: Set wksTarget = Nothing: sTargetAddr = "" End Sub -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
OnTime Change_Event macro AND copy to sheet2 macro trouble
Thanks Garry, I believe this will do and both examples are useful. Seems to work fine if the changes are made with a copy and paste en mass as opposed to typing in a few individual changes. With the individual changes it seem to not copy all of them and errors out on this line: For Each c In wksSource.Range(sTargetAddr) I think what I am up against is that the expectation is that numerous changes at different intervals will occur in the range and when the On Time has expired the code gathers everything that has changed and does it copy and paste work. Just to get my head clear on this, once a single change is made to the range the count down begins and when it expires, calls the copy macro and it does its work with whatever is in the range at that time. Is that correct? Howard |
OnTime Change_Event macro AND copy to sheet2 macro trouble
On Sunday, June 2, 2013 10:06:03 PM UTC-7, Howard wrote:
Thanks Garry, I believe this will do and both examples are useful. Seems to work fine if the changes are made with a copy and paste en mass as opposed to typing in a few individual changes. With the individual changes it seem to not copy all of them and errors out on this line: For Each c In wksSource.Range(sTargetAddr) I think what I am up against is that the expectation is that numerous changes at different intervals will occur in the range and when the On Time has expired the code gathers everything that has changed and does it copy and paste work. Just to get my head clear on this, once a single change is made to the range the count down begins and when it expires, calls the copy macro and it does its work with whatever is in the range at that time. Is that correct? Howard Just to add, paste special values will be need as there are formulas also. Sorry, my overlook. Howard |
OnTime Change_Event macro AND copy to sheet2 macro trouble
Thanks Garry, I believe this will do and both examples are useful.
Seems to work fine if the changes are made with a copy and paste en mass as opposed to typing in a few individual changes. With the individual changes it seem to not copy all of them and errors out on this line: For Each c In wksSource.Range(sTargetAddr) This happens when a single cell has changed. The code assumes more than 1 cell changes during the interval, and so needs to be modified to accomodate single cells being processed. Note that once an initial change occurs, the value in sTargetAddr will change if subsequent changes occur before the OnTime expires. This is probably *not* the way to go. I think what I am up against is that the expectation is that numerous changes at different intervals will occur in the range and when the On Time has expired the code gathers everything that has changed and does it copy and paste work. Not clear on your insistence to copy/paste when all that's needed is to assign the values directly to the target cells, obviating the extra processing of Copy/PasteSpecial. Just to get my head clear on this, once a single change is made to the range the count down begins and when it expires, calls the copy macro and it does its work with whatever is in the range at that time. In this case I'd go with the 1st example. This, of course, with fill every row in every column whether changes happened in that row or not. In this scenario I'd be inclined to transfer the values in one step rather than loop each cell... Revise _Change event as follows... Private Sub Worksheet_Change(ByVal Target As Range) 'Only copy if change is within specified range If Not Intersect(Target, Me.Range("A1:A15")) Is Nothing Then Set wksSource = Me Application.OnTime Now + TimeValue("00:00:10"), "TheNameOfMySub" End If End Sub Revise module code as follows... Option Explicit Public wksSource As Worksheet, wksTarget As Worksheet, rngSource As Range Sub TransferData() Dim lPos&, lRows& 'As Long lRows = rngSource.Rows.Count With wksTarget lPos = .Cells(1, .Columns.Count).End(xlToLeft)(2).Column If Not .Cells(1, lPos) = "" Then lPos = lPos + 1 .Cells(1, lPos).Resize(lRows, 1).Value = rngSource.Value End With End Sub Sub TheNameOfMySub() Set rngSource = wksSource.Range("A1:A15") '//edit to suit Set wksTarget = ThisWorkbook.Sheets("Sheet2") '//edit to suit Call TransferData 'Cleanup Set rngSource = Nothing: Set wksTarget = Nothing End Sub Note that individual changes made during the duration will cause the event to fire once for each change. You may want to disable events once the 1st change happens while the data transfer processes... Revise the _Change event as follows... Private Sub Worksheet_Change(ByVal Target As Range) 'Only copy if change is within specified range If Not Intersect(Target, Me.Range("A1:A15")) Is Nothing Then Set wksSource = Me With Application .EnableEvents = False .OnTime Now + TimeValue("00:00:10"), "TheNameOfMySub" End With End If End Sub ...and the module code as follows... Sub TheNameOfMySub() Set rngSource = wksSource.Range("A1:A15") '//edit to suit Set wksTarget = ThisWorkbook.Sheets("Sheet2") '//edit to suit Call TransferData 'Cleanup Set rngSource = Nothing: Set wksTarget = Nothing Application.EnableEvents = True End Sub ...so your code only processes once per OnTime duration. -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
OnTime Change_Event macro AND copy to sheet2 macro trouble
Thanks Garry, that is an excellent lesson on this project. Clears up a bunch of stuff for me and I appreciate the optional codes you have offered.
Regards, Howard |
OnTime Change_Event macro AND copy to sheet2 macro trouble
Thanks Garry, that is an excellent lesson on this project. Clears up
a bunch of stuff for me and I appreciate the optional codes you have offered. Regards, Howard You're welcome.., always glad to help! I appreciate the feedback... -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
All times are GMT +1. The time now is 04:00 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com