mokie
03-19-2018, 01:05 AM
Hello, dear friends please show me where I lost in my code becouse I don't have good result in it.
I thing I'm lost in iteration in 3 loops for / next.
I was trying compare 3 arrays and after matching copy to worksheet in
TABLE1 (unique)
TABLE3 (duplicates) - diffrent position of column
TABLE2 (source table with new record)
arr1 (TABLE1) - destination new uniqe record
arr2 (TABLE2) - source record
arr3 (TABLE3) - dupicate record in arr1=arr2. But check if exist in arr3. If exist do not copy again to table 3.
thanks in advanced.
Sub compareArrays_copyRecord()
Dim arr
Dim arr2
Dim j As Long
Dim k As Long
Dim o As Long
Dim BlankRow As Long
BlankRow = Sheets("MAIN").Cells(Rows.Count, 1).End(xlUp).Row
BlankRowG = Sheets("MAIN").Cells(Rows.Count, 7).End(xlUp).Row
'' Array1 of destination of uniqe records
arr = Range("A5").CurrentRegion.Value
'' Array2 - source of new record. Many of record is duplicates. Must check if exist in table1 if not then paste to Table3. If exist on Table3 do not copy at all.
arr2 = Range("M5").CurrentRegion.Value
'' Array from G19. Check is the record is exist from arr2(Source) - table2 . Do not copy again to table1 or table3.
arr3 = Range("G5").CurrentRegion.Value
For o = LBound(arr3) To UBound(arr3)
For k = LBound(arr2) To UBound(arr2)
For j = LBound(arr) To UBound(arr)
'' (Table1) header 2 , 3, 4 <> or = (table2) header 2 , 3 , 4
If arr(j, 2) & arr(j, 3) & arr(j, 4) <> arr2(k, 2) & arr2(k, 3) & arr2(k, 4) Then
'in columnG(arr3) paste record exist in colA(arr1) and colM(arr2)
If arr2(k, 2) & arr2(k, 4) & arr2(k, 3) <> arr3(o, 1) & arr3(o, 2) & arr3(o, 3) Then
Cells(BlankRowG + 1, 7).Select
Selection = arr3(o, 1)
Selection.Offset(0, 1) = arr3(o, 2)
Selection.Offset(0, 2) = arr3(o, 3)
Selection.Offset(0, 3) = arr3(o, 4)
If arr(j, 2) & arr(j, 3) & arr(j, 4) = arr2(k, 2) & arr2(k, 3) & arr2(k, 4) Then
Cells(BlankRow + 1, 1).Select
Selection = arr2(k, 1)
Selection.Offset(0, 1) = arr2(k, 2)
Selection.Offset(0, 2) = arr2(k, 3)
Selection.Offset(0, 3) = arr2(k, 4)
Selection.Offset(0, 4) = arr2(k, 5)
End If
End If
End If
Next j
Next k
Next o
End Sub
I thing I'm lost in iteration in 3 loops for / next.
I was trying compare 3 arrays and after matching copy to worksheet in
TABLE1 (unique)
TABLE3 (duplicates) - diffrent position of column
TABLE2 (source table with new record)
arr1 (TABLE1) - destination new uniqe record
arr2 (TABLE2) - source record
arr3 (TABLE3) - dupicate record in arr1=arr2. But check if exist in arr3. If exist do not copy again to table 3.
thanks in advanced.
Sub compareArrays_copyRecord()
Dim arr
Dim arr2
Dim j As Long
Dim k As Long
Dim o As Long
Dim BlankRow As Long
BlankRow = Sheets("MAIN").Cells(Rows.Count, 1).End(xlUp).Row
BlankRowG = Sheets("MAIN").Cells(Rows.Count, 7).End(xlUp).Row
'' Array1 of destination of uniqe records
arr = Range("A5").CurrentRegion.Value
'' Array2 - source of new record. Many of record is duplicates. Must check if exist in table1 if not then paste to Table3. If exist on Table3 do not copy at all.
arr2 = Range("M5").CurrentRegion.Value
'' Array from G19. Check is the record is exist from arr2(Source) - table2 . Do not copy again to table1 or table3.
arr3 = Range("G5").CurrentRegion.Value
For o = LBound(arr3) To UBound(arr3)
For k = LBound(arr2) To UBound(arr2)
For j = LBound(arr) To UBound(arr)
'' (Table1) header 2 , 3, 4 <> or = (table2) header 2 , 3 , 4
If arr(j, 2) & arr(j, 3) & arr(j, 4) <> arr2(k, 2) & arr2(k, 3) & arr2(k, 4) Then
'in columnG(arr3) paste record exist in colA(arr1) and colM(arr2)
If arr2(k, 2) & arr2(k, 4) & arr2(k, 3) <> arr3(o, 1) & arr3(o, 2) & arr3(o, 3) Then
Cells(BlankRowG + 1, 7).Select
Selection = arr3(o, 1)
Selection.Offset(0, 1) = arr3(o, 2)
Selection.Offset(0, 2) = arr3(o, 3)
Selection.Offset(0, 3) = arr3(o, 4)
If arr(j, 2) & arr(j, 3) & arr(j, 4) = arr2(k, 2) & arr2(k, 3) & arr2(k, 4) Then
Cells(BlankRow + 1, 1).Select
Selection = arr2(k, 1)
Selection.Offset(0, 1) = arr2(k, 2)
Selection.Offset(0, 2) = arr2(k, 3)
Selection.Offset(0, 3) = arr2(k, 4)
Selection.Offset(0, 4) = arr2(k, 5)
End If
End If
End If
Next j
Next k
Next o
End Sub