deedii
12-28-2011, 05:44 PM
Guys a lil help here. I am sorting my code the problem why it keeps duplicating the data when i run the macro when it supposed to add only the new entry not duplicate the existing data. Am i missing something with this code?
Sub copy_2()
Dim x(), y(), rez(), i&, j&, lr&, s$
With Sheets("Sheet2")
x = .Range("A2:T" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
lr = .Cells(Rows.Count, "A").End(xlUp).Row + 1
End With
With Sheets("Sheet1")
y = .Range("A2:X" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
End With
ReDim rez(1 To UBound(y), 1 To 24)
On Error Resume Next
With New Collection
If IsArray(x) Then
For i = 1 To UBound(x)
s = Trim(x(i, 1)) & Trim(x(i, 2))
If IsEmpty(.Item(s)) Then .Add 0, s
Next i
End If
For i = 1 To UBound(y)
If Trim(y(i, 12)) = "transfer" Then
s = Trim(y(i, 1)) & Trim(y(i, 2))
If IsEmpty(.Item(s)) Then
j = j + 1
rez(j, 1) = y(i, 1)
rez(j, 3) = y(i, 2)
rez(j, 4) = y(i, 3)
rez(j, 5) = y(i, 4)
rez(j, 6) = y(i, 5)
rez(j, 7) = y(i, 6)
rez(j, 9) = y(i, 7)
rez(j, 10) = y(i, 8)
rez(j, 11) = y(i, 9)
rez(j, 12) = y(i, 10)
rez(j, 13) = y(i, 11)
rez(j, 14) = y(i, 12)
rez(j, 21) = y(i, 19)
rez(j, 22) = y(i, 20)
End If
End If
Next i
End With
If j > 0 Then Sheets("Sheet2").Cells(lr, 1).Resize(j, 24).Value = rez()
End Sub
Using this wont solve it either;
Range("A2").Select
ActiveSheet.Range("$A$1:$X$22").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7 _
, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24), Header:=xlYes
Sub copy_2()
Dim x(), y(), rez(), i&, j&, lr&, s$
With Sheets("Sheet2")
x = .Range("A2:T" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
lr = .Cells(Rows.Count, "A").End(xlUp).Row + 1
End With
With Sheets("Sheet1")
y = .Range("A2:X" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
End With
ReDim rez(1 To UBound(y), 1 To 24)
On Error Resume Next
With New Collection
If IsArray(x) Then
For i = 1 To UBound(x)
s = Trim(x(i, 1)) & Trim(x(i, 2))
If IsEmpty(.Item(s)) Then .Add 0, s
Next i
End If
For i = 1 To UBound(y)
If Trim(y(i, 12)) = "transfer" Then
s = Trim(y(i, 1)) & Trim(y(i, 2))
If IsEmpty(.Item(s)) Then
j = j + 1
rez(j, 1) = y(i, 1)
rez(j, 3) = y(i, 2)
rez(j, 4) = y(i, 3)
rez(j, 5) = y(i, 4)
rez(j, 6) = y(i, 5)
rez(j, 7) = y(i, 6)
rez(j, 9) = y(i, 7)
rez(j, 10) = y(i, 8)
rez(j, 11) = y(i, 9)
rez(j, 12) = y(i, 10)
rez(j, 13) = y(i, 11)
rez(j, 14) = y(i, 12)
rez(j, 21) = y(i, 19)
rez(j, 22) = y(i, 20)
End If
End If
Next i
End With
If j > 0 Then Sheets("Sheet2").Cells(lr, 1).Resize(j, 24).Value = rez()
End Sub
Using this wont solve it either;
Range("A2").Select
ActiveSheet.Range("$A$1:$X$22").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7 _
, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24), Header:=xlYes