OnTime Change_Event macro AND copy to sheet2 macro trouble

  • Thread starter Thread starter Howard
  • Start date Start date
H

Howard

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 are:

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
 
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
 
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
 
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
 
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
Click to expand...

Just to add, paste special values will be need as there are formulas also.

Sorry, my overlook.

Howard
 
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)
Click to expand...

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.
Click to expand...

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.
Click to expand...

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
 
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
 
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
Click to expand...

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
 
Back
Top