Copy range from loop

**malefeous** · 08-10-2005, 08:21 AM

I'm having trouble with this big time. I have a loop setup that runs through two worksheets and compares the data in both. When the loop comes across a cell on both worksheets that are similar I want it to take that entire row and put it on another worksheet. When it comes across a cell on both that are different I want it to send it to yet another worksheet. This really is frustrating me. I know it's should just be a matter of syntax, but I cannot get the right 'combination'.

Tom Ogilvy · 08-10-2005, 10:05 AM

Try this code recently posted by KeepItCool:

Try following.

It's a general routine that's very fast and convenient
(the input arrays must contain unique ID's.)

Be aware that the returned arrays are 0 based.
ubound = -1 when empty.

Sub DemoMatchCols()
Dim vMatches
vMatches = ArrayMatcher(Range("a:a"), Range("b:b"))

If UBound(vMatches(0)) > -1 Then
Range("d1").Resize(1 + UBound(vMatches(0))) = _
Application.Transpose(vMatches(0))
End If
If UBound(vMatches(1)) > -1 Then
Range("e1").Resize(1 + UBound(vMatches(1))) = _
Application.Transpose(vMatches(1))
End If
If UBound(vMatches(2)) > -1 Then
Range("f1").Resize(1 + UBound(vMatches(2))) = _
Application.Transpose(vMatches(2))
End If
End Sub

Function ArrayMatcher(ByVal List1 As Variant, _
ByVal List2 As Variant, _
Optional bIgnoreCase As Boolean = True)
'compares the values from 2 arrays
'and returns an array of 3 arrays of
'unique items(items left, items both, items right)
'
'author keepITcool excel.programming aug 9th,2005

'requires a reference to Microsoft Scripting Runtime
Dim dic(3) As Scripting.Dictionary
Dim itm, key, res
Dim i As Integer

For i = 0 To 3
Set dic(i) = New Dictionary
dic(i).CompareMode = IIf(bIgnoreCase, TextCompare, BinaryCompare)
Next

If Not IsArray(List1) Then Exit Function
If Not IsArray(List2) Then Exit Function
If Not IsArray(List1) Then Exit Function
If Not IsArray(List2) Then Exit Function
If TypeName(List1) = "Range" Then List1 = _
Intersect(List2.Parent.UsedRange, List1).Value
If TypeName(List2) = "Range" Then List2 = _
Intersect(List2.Parent.UsedRange, List2).Value

On Error Resume Next
'loop List1 and add all unique items to dic(3)
'dic(3) will be discarded later
For Each itm In List1
dic(3).Add CStr(itm), itm
Next

'loop List2:
'If found in dic(3) then add to dic(1) else add to dic(2)
For Each itm In List2
If dic(3).Exists(CStr(itm)) Then
dic(1).Add CStr(itm), itm
Else
dic(2).Add CStr(itm), itm
End If
Next

'loop dic(3):
'if not found add to dic(0)
For Each key In dic(3)
If Not dic(2).Exists(key) Then
dic(0).Add key, dic(3)(key)
End If
Next
Set dic(3) = Nothing
dic(2).Remove (vbNullString)
dic(1).Remove (vbNullString)
dic(0).Remove (vbNullString)

ReDim res(2)
res(0) = dic(0).Items
res(1) = dic(1).Items
res(2) = dic(2).Items
ArrayMatcher = res

End Function

--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam

--
Regards,
Tom Ogilvy

"malefeous" <[email protected]> wrote
in message news:[email protected]...
>
> I'm having trouble with this big time. I have a loop setup that runs
> through two worksheets and compares the data in both. When the loop
> comes across a cell on both worksheets that are similar I want it to
> take that entire row and put it on another worksheet. When it comes
> across a cell on both that are different I want it to send it to yet
> another worksheet. This really is frustrating me. I know it's should
> just be a matter of syntax, but I cannot get the right 'combination'.
>
>
> --
> malefeous
> ------------------------------------------------------------------------
> malefeous's Profile:
http://www.excelforum.com/member.php...o&userid=26063
> View this thread: http://www.excelforum.com/showthread...hreadid=394559
>

**malefeous** · 08-10-2005, 10:21 AM

Is it possibel to do it without an array? I'm looking it over now, but I was hoping that I could get it to do a copy and paste while it is looping. As soon as it finds a difference could it just select the row that the cell is in and copy it? Thanks for the reply, I have been posting since monday, your the first to answer.

Tom Ogilvy · 08-10-2005, 01:05 PM

As written, compares data in column 1 in sheet1 and sheet2

Data to be copies is in Sheet1. Data to be compared to is in Sheet2

rows in Sheet1 that match to a value in Sheet2 are copied to Sheet Matches
rows in Sheet1 that don't match to a value in Sheet2 are copied to Sheet
Uniques

Adjust to meet your situation.

Sub CopyData()
Dim rng1 as Range, rng2 as Range
Dim rng3 as Range, rng4 as Range
Dim cell as Range, res as Variant
With worksheets("Sheet1")
set rng1 = .Range(.Cells(1,1),.Cells(rows.count,1).End(xlup))
End With
With worksheets("Sheet2")
set rng2 = .Range(.Cells(1,1),.Cells(rows.count,1).End(xlup))
End With
for each cell in rng1
res = Application.Match(cell,rng2,0)
if not iserror(res) then
set rng3 = rng2(res)
set rng4 = worksheets("Match").Cells(rows.count,1).End(xlup)(2)
cell.EntireRow.copy Destination:=rng4
else
set rng4 = Worksheets("Unique").Cells(rows.count,1).End(xlup)(2)
cell.entireRow.copy destination:=rng4
end if
Next
End sub

--
Regards,
Tom Ogilvy

"malefeous" <[email protected]> wrote
in message news:[email protected]...
>
> I'm having trouble with this big time. I have a loop setup that runs
> through two worksheets and compares the data in both. When the loop
> comes across a cell on both worksheets that are similar I want it to
> take that entire row and put it on another worksheet. When it comes
> across a cell on both that are different I want it to send it to yet
> another worksheet. This really is frustrating me. I know it's should
> just be a matter of syntax, but I cannot get the right 'combination'.
>
>
> --
> malefeous
> ------------------------------------------------------------------------
> malefeous's Profile:
http://www.excelforum.com/member.php...o&userid=26063
> View this thread: http://www.excelforum.com/showthread...hreadid=394559
>