Comparing Multidimensional Arrays?

[Rshow]

Hello,
I have coded the following, but am wondering if there is a better way of
doing this.

Basically i'm comparing two 3D arrays, to see if the data from array1 is in
array2.
If it isn't, i'm copying the data over to the sheet.

heres the code and any help to do this a quicker way would be appreciated.
right now the code takes 5 minutes to run when MFArray is 2500 rows and
SNArray is 16,000 rows.

Thank you.


Public Sub CompareArrays()
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Dim MFArray As Variant
Dim SNArray As Variant
Dim Match As String
Dim MFArrayEnd As Integer
Dim SNArrayEnd As Integer

MFArrayEnd = Sheets("MFrameAENames").UsedRange.Rows.Count
SNArrayEnd = Sheets("SalesnetAENames").UsedRange.Rows.Count
MFArray = Sheets("MFrameAENames").Range("A2:C" & MFArrayEnd).Value
SNArray = Sheets("SalesnetAENames").Range("A2:C" & SNArrayEnd).Value


For a = 1 To MFArrayEnd - 1
Match = "No"

Do Until Match = "Yes"
For b = 1 To SNArrayEnd - 1
If MFArray(a, 1) = SNArray(b, 1) And MFArray(a, 2) =
SNArray(b, 2) And MFArray(a, 3) = SNArray(b, 3) Then
Match = "Yes"
Else
End If
Next b
Exit Do
Loop

If Match = "No" Then
Sheets("MFrameAENames").Select
Range("A" & a + 1 & ":S" & a + 1).Select
Selection.Copy
Sheets("SalesnetAENames").Select
Range("A" & ActiveSheet.UsedRange.Rows.Count + 1).Select
ActiveSheet.Paste
Else
End If
Next a
With Application
CalcMode = .Calculation
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

 

[Guest]

Rshow,
Try this.

It creates a "key" in column A (inserted) of each worksheet consisting of
the concatenation of cells A,B and C. It then uses MATCH to match one range
versus the other and inserts record if no match found.

At the end, the inserted columns are deleted.

Make sure you take a copy of your data BEFORE testing!

HTH

Public Sub CompareArrays()

With Application
.ScreenUpdating = False
End With

Dim MFArray As Variant
Dim SNArray As Variant
Dim Match As String
Dim MFArrayEnd As Long
Dim SNArrayEnd As Long
Dim Nextrow As Long
Dim MFrng As Range, SNrng As Range

Dim Start, Finish, TotalTime

Start = Timer ' Set start time.

Set ws1 = Worksheets("MFrameAENames")
Set ws2 = Worksheets("SalesnetAENames")

' Add work column A To both worksheets which contain concatenation of A,B
and C

With ws1
MFArray = .Range("A2:C" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
.Columns("A:A").Insert Shift:=xlToRight
.Columns("A:A").NumberFormat = "@"
' create "key" for MF
For r = 2 To .Cells(Rows.Count, "b").End(xlUp).Row
.Cells(r, 1) = .Cells(r, 2) & .Cells(r, 3) & .Cells(r, 4)
Next r
Set MFrng = .Range("a2:a" & Cells(Rows.Count, "A").End(xlUp).Row)
End With

With ws2
SNArray = .Range("A2:C" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
Nextrow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Columns("A:A").Insert Shift:=xlToRight
.Columns("A:A").NumberFormat = "@"
' Create "key" for SN
For r = 2 To .Cells(Rows.Count, "B").End(xlUp).Row
.Cells(r, 1) = .Cells(r, 2) & .Cells(r, 3) & .Cells(r, 4)
Next r
Set SNrng = .Range("a2:a" & Cells(Rows.Count, "A").End(xlUp).Row)
End With

nx = 0
' Match "Keys" in both worksheets

For Each cell In MFrng
res = Application.Match(cell, SNrng, 0)
If IsError(res) Then ' No match found ....
a = cell.Row
ws1.Range("B" & a & ":T" & a).Copy ws2.Range("B" & Nextrow)
Nextrow = Nextrow + 1
nx = nx + 1
End If
Next cell

' Delete work columns

ws1.Columns("A:A").Delete Shift:=xlToLeft
ws2.Columns("A:A").Delete Shift:=xlToLeft

With Application
CalcMode = .Calculation
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

Finish = Timer ' Set end time.
TotalTime = Finish - Start ' Calculate total time.
MsgBox TotalTime & " seconds " & nx & " additions"
End Sub

 

[Guest]

Hi,
A couple of typos [missed the "." before the Cells( ...)] :

Set MFrng = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)

Set SNrng = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)