Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Comparing Multidimensional Arrays?
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Comparing Multidimensional Arrays?
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 "Rshow" wrote: 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Comparing Multidimensional Arrays?
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) "Toppers" wrote: 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 "Rshow" wrote: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
ReDim, Preserve and Multidimensional arrays | Excel Programming | |||
Declare Multidimensional Arrays | Excel Programming | |||
Declare Multidimensional Arrays | Excel Programming | |||
Multidimensional Arrays - VBA | Excel Programming | |||
Multidimensional Arrays - VBA | Excel Programming |