Efficient Copy/Paste

Hi, I recently wrote someone a solution as shown below. The OP wanted to
compare values in col A on two sheets -- Source and Dest. If the values were
equal on any given row, he wanted contents from Columns I and K to be copied
from Source to Dest for that row (to I and K, respectively).

Because the ranges copied from are staggered and the ranges copied to are
non-contiguous, I saw no way to add the cells to a range for bulk
copy/paste -- so of course the solution takes a long time (the user said
about 35,000 rows to check, but I am not sure how many cop/pastes would have
resulted)

Can the code be made more efficient in this case?

Thanks!

Sub CopyIdenticals()
Dim rngSourceCompare As Range
Dim c As Range

On Error Resume Next
Set rngSourceCompare = Application.InputBox _
(prompt:="Select all cells in col A for comparison", _
Type:=8)
If rngSourceCompare Is Nothing Then
Exit Sub
End If

If rngSourceCompare.Parent.Name <> "Source" Then
MsgBox "Only choose col A values on sheet 'Source'"
Exit Sub
End If

On Error GoTo 0
Application.ScreenUpdating = False
For Each c In rngSourceCompare

If c.Value = Sheets("Dest").Range(c.Address).Value Then
c.Offset(0, 8).Copy 'note: Col I
Sheets("Dest").Range("I" & c.Row).PasteSpecial _
Paste:=xlPasteValues
c.Offset(0, 10).Copy 'note: Col K
Sheets("Dest").Range("K" & c.Row).PasteSpecial _
Paste:=xlPasteValues
End If
Next c
Application.ScreenUpdating = True
End Sub

Sub CopyIdenticals()
Dim rngSourceCompare As Range
Dim rngDest as Range
Dim v1, v2, v1IJK, v2IJK
Dim i as Long
On Error Resume Next
Set rngSourceCompare = Application.InputBox _
(prompt:="Select all cells in col A for comparison", _
Type:=8)
If rngSourceCompare Is Nothing Then
Exit Sub
End If

If rngSourceCompare.Parent.Name <> "Source" Then
MsgBox "Only choose col A values on sheet 'Source'"
Exit Sub
End If

On Error GoTo 0
Application.ScreenUpdating = False
v1 = rngSourceCompare.Value
rngDest = Worksheets("Dest").Range(rngsourceCompare.Address)
v2 = rngDest.Value
v1IJK = rngSourceCompare.Offset(0,8).Resize(,3).Value
v2IJK = rng.Dest.Offset(0,8).Resize(,3).Formula
for i = lbound(v1,1) to ubound(v1,1)
if v1(i,1) = v2(i,1) then
v2IJK(i,1) = v1IJK(i,1)
v2IJK(i,3) = v1IJK(i,3)
end if
Next
rngDest.Offset(0,8).Resize(,3).Formula = v2IJK
Application.ScreenUpdating = True
End Sub


--
Regards,
Tom Ogilvy


"William Benson" <wbenson1(SPAMSUCKS)@nycap.rr.com> wrote in message
news:[email protected]...
> Hi, I recently wrote someone a solution as shown below. The OP wanted to
> compare values in col A on two sheets -- Source and Dest. If the values
were
> equal on any given row, he wanted contents from Columns I and K to be
copied
> from Source to Dest for that row (to I and K, respectively).
>
> Because the ranges copied from are staggered and the ranges copied to are
> non-contiguous, I saw no way to add the cells to a range for bulk
> copy/paste -- so of course the solution takes a long time (the user said
> about 35,000 rows to check, but I am not sure how many cop/pastes would
have
> resulted)
>
> Can the code be made more efficient in this case?
>
> Thanks!
>
> Sub CopyIdenticals()
> Dim rngSourceCompare As Range
> Dim c As Range
>
> On Error Resume Next
> Set rngSourceCompare = Application.InputBox _
> (prompt:="Select all cells in col A for comparison", _
> Type:=8)
> If rngSourceCompare Is Nothing Then
> Exit Sub
> End If
>
> If rngSourceCompare.Parent.Name <> "Source" Then
> MsgBox "Only choose col A values on sheet 'Source'"
> Exit Sub
> End If
>
> On Error GoTo 0
> Application.ScreenUpdating = False
> For Each c In rngSourceCompare
>
> If c.Value = Sheets("Dest").Range(c.Address).Value Then
> c.Offset(0, 8).Copy 'note: Col I
> Sheets("Dest").Range("I" & c.Row).PasteSpecial _
> Paste:=xlPasteValues
> c.Offset(0, 10).Copy 'note: Col K
> Sheets("Dest").Range("K" & c.Row).PasteSpecial _
> Paste:=xlPasteValues
> End If
> Next c
> Application.ScreenUpdating = True
> End Sub
>
>

Probably ought to set calculation to manual as well.

--
Regards,
Tom Ogilvy

"William Benson" <wbenson1(SPAMSUCKS)@nycap.rr.com> wrote in message
news:[email protected]...
> Hi, I recently wrote someone a solution as shown below. The OP wanted to
> compare values in col A on two sheets -- Source and Dest. If the values
were
> equal on any given row, he wanted contents from Columns I and K to be
copied
> from Source to Dest for that row (to I and K, respectively).
>
> Because the ranges copied from are staggered and the ranges copied to are
> non-contiguous, I saw no way to add the cells to a range for bulk
> copy/paste -- so of course the solution takes a long time (the user said
> about 35,000 rows to check, but I am not sure how many cop/pastes would
have
> resulted)
>
> Can the code be made more efficient in this case?
>
> Thanks!
>
> Sub CopyIdenticals()
> Dim rngSourceCompare As Range
> Dim c As Range
>
> On Error Resume Next
> Set rngSourceCompare = Application.InputBox _
> (prompt:="Select all cells in col A for comparison", _
> Type:=8)
> If rngSourceCompare Is Nothing Then
> Exit Sub
> End If
>
> If rngSourceCompare.Parent.Name <> "Source" Then
> MsgBox "Only choose col A values on sheet 'Source'"
> Exit Sub
> End If
>
> On Error GoTo 0
> Application.ScreenUpdating = False
> For Each c In rngSourceCompare
>
> If c.Value = Sheets("Dest").Range(c.Address).Value Then
> c.Offset(0, 8).Copy 'note: Col I
> Sheets("Dest").Range("I" & c.Row).PasteSpecial _
> Paste:=xlPasteValues
> c.Offset(0, 10).Copy 'note: Col K
> Sheets("Dest").Range("K" & c.Row).PasteSpecial _
> Paste:=xlPasteValues
> End If
> Next c
> Application.ScreenUpdating = True
> End Sub
>
>

Couple typos: rng.Dest should be rngDest, and since rngDest is a range,
needed to use "Set" on the code line you used to assign it. Seems like you
wrote this from your head?? I just wish I understood it Tom :-(

Once I cleared up these, the improved performance was AMAZING!!! Wow.
Thanks,

Bill

"Tom Ogilvy" <[email protected]> wrote in message
news:[email protected]...
> Probably ought to set calculation to manual as well.
>
> --
> Regards,
> Tom Ogilvy
>
> "William Benson" <wbenson1(SPAMSUCKS)@nycap.rr.com> wrote in message
> news:[email protected]...
>> Hi, I recently wrote someone a solution as shown below. The OP wanted to
>> compare values in col A on two sheets -- Source and Dest. If the values
> were
>> equal on any given row, he wanted contents from Columns I and K to be
> copied
>> from Source to Dest for that row (to I and K, respectively).
>>
>> Because the ranges copied from are staggered and the ranges copied to are
>> non-contiguous, I saw no way to add the cells to a range for bulk
>> copy/paste -- so of course the solution takes a long time (the user said
>> about 35,000 rows to check, but I am not sure how many cop/pastes would
> have
>> resulted)
>>
>> Can the code be made more efficient in this case?
>>
>> Thanks!
>>
>> Sub CopyIdenticals()
>> Dim rngSourceCompare As Range
>> Dim c As Range
>>
>> On Error Resume Next
>> Set rngSourceCompare = Application.InputBox _
>> (prompt:="Select all cells in col A for comparison", _
>> Type:=8)
>> If rngSourceCompare Is Nothing Then
>> Exit Sub
>> End If
>>
>> If rngSourceCompare.Parent.Name <> "Source" Then
>> MsgBox "Only choose col A values on sheet 'Source'"
>> Exit Sub
>> End If
>>
>> On Error GoTo 0
>> Application.ScreenUpdating = False
>> For Each c In rngSourceCompare
>>
>> If c.Value = Sheets("Dest").Range(c.Address).Value Then
>> c.Offset(0, 8).Copy 'note: Col I
>> Sheets("Dest").Range("I" & c.Row).PasteSpecial _
>> Paste:=xlPasteValues
>> c.Offset(0, 10).Copy 'note: Col K
>> Sheets("Dest").Range("K" & c.Row).PasteSpecial _
>> Paste:=xlPasteValues
>> End If
>> Next c
>> Application.ScreenUpdating = True
>> End Sub
>>
>>
>
>

By George I think I've got it.

So, you assigned all of the destination cells first to v2IJK, a N x 3
array.

v2IJK = rngDest.Offset(0, 8).Resize(, 3).Formula

to preserve the cells that should not be over-written.


and then, you change only the elements of the array that deserve to be
changed.

Then you just write back the contents of the revised array to the Dest
range.

rngDest.Offset(0, 8).Resize(, 3).Formula = v2IJK

Miraculous!

Thanks a million!


"William Benson" <wbenson1(SPAMSUCKS)@nycap.rr.com> wrote in message
news:uJa%[email protected]...
> Couple typos: rng.Dest should be rngDest, and since rngDest is a range,
> needed to use "Set" on the code line you used to assign it. Seems like you
> wrote this from your head?? I just wish I understood it Tom :-(
>
> Once I cleared up these, the improved performance was AMAZING!!! Wow.
> Thanks,
>
> Bill
>
> "Tom Ogilvy" <[email protected]> wrote in message
> news:[email protected]...
>> Probably ought to set calculation to manual as well.
>>
>> --
>> Regards,
>> Tom Ogilvy
>>
>> "William Benson" <wbenson1(SPAMSUCKS)@nycap.rr.com> wrote in message
>> news:[email protected]...
>>> Hi, I recently wrote someone a solution as shown below. The OP wanted to
>>> compare values in col A on two sheets -- Source and Dest. If the values
>> were
>>> equal on any given row, he wanted contents from Columns I and K to be
>> copied
>>> from Source to Dest for that row (to I and K, respectively).
>>>
>>> Because the ranges copied from are staggered and the ranges copied to
>>> are
>>> non-contiguous, I saw no way to add the cells to a range for bulk
>>> copy/paste -- so of course the solution takes a long time (the user said
>>> about 35,000 rows to check, but I am not sure how many cop/pastes would
>> have
>>> resulted)
>>>
>>> Can the code be made more efficient in this case?
>>>
>>> Thanks!
>>>
>>> Sub CopyIdenticals()
>>> Dim rngSourceCompare As Range
>>> Dim c As Range
>>>
>>> On Error Resume Next
>>> Set rngSourceCompare = Application.InputBox _
>>> (prompt:="Select all cells in col A for comparison", _
>>> Type:=8)
>>> If rngSourceCompare Is Nothing Then
>>> Exit Sub
>>> End If
>>>
>>> If rngSourceCompare.Parent.Name <> "Source" Then
>>> MsgBox "Only choose col A values on sheet 'Source'"
>>> Exit Sub
>>> End If
>>>
>>> On Error GoTo 0
>>> Application.ScreenUpdating = False
>>> For Each c In rngSourceCompare
>>>
>>> If c.Value = Sheets("Dest").Range(c.Address).Value Then
>>> c.Offset(0, 8).Copy 'note: Col I
>>> Sheets("Dest").Range("I" & c.Row).PasteSpecial _
>>> Paste:=xlPasteValues
>>> c.Offset(0, 10).Copy 'note: Col K
>>> Sheets("Dest").Range("K" & c.Row).PasteSpecial _
>>> Paste:=xlPasteValues
>>> End If
>>> Next c
>>> Application.ScreenUpdating = True
>>> End Sub
>>>
>>>
>>
>>
>
>