How to copy the row from duplicate rows if the conditions are met through VBA

[Maruthiveer]

I have an excel master sheet (output) with columns "A" to "AL", The column "A" will have ID's,column "k" has date , column "AB" have sequence(0,1,2,3,4..) and column "AL" have row count(2,3,4,5,6..). The column A will have same values sometimes i.e,(Duplicate values). I need to copy the entire row through the below conditions:

if row count(AB) =2
check for any duplicate ID's in (coloumn "A")
1.if no duplicate ID's found then copy that row and paste it in sheet2 ( Final Output).
2.If Duplicate ID's found , copy the row with the highest sequence number (AB) to sheet 2.
3.If Duplicate ID's found and the sequence number is also same then copy the row with the date(K),whichever date is recent one that row should be copied and paste in the sheet2.
same process for the rowcount= 3,4,5,..

can any one can help me ..

 

[offthelip]

there is a slight ambiguity about your check for row count you say first that this is in AL but you have got "if row count(AB) =2 " I assume it is in AL because AB appears to have sequence number.
I haven't tested this but it should show you how to do it:

Sub test()
Dim outarr()
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(Cells(1, 1), Cells(lastrow, 38)) ' pick A1 to Al lastrow
ReDim outarr(1 To lastrow, 1 To 38)
indi = 2
For i = 2 To lastrow
 If inarr(i, 38) = 2 Then ' check is AL = 2 your requirements are ambiguous I presume row count is in AL
   currentid = inarr(i, 1)
    copi = i
    For j = i To lastrow
      ' look for duplicates
       If inarr(j, 1) = currentid Then
        If copi = i Then  ' check if it is the first duplicate
          copi = j
        Else
         ' check sequnce number AB
          If inarr(j, 28) > inarr(copi, 28) Then
           inarr(copi, 1) = "" ' clear previous duplicate to avoid copying agian
           copi = j
          Else
           ' check if sequnce number equal
                If inarr(j, 28) = inarr(copi, 28) Then
                   ' check dates
                 If inarr(j, 11) > inarr(copi, 11) Then
                    inarr(copi, 1) = "" ' clear previous duplicate to avoid copying agian
                    copi = j
                 End If
                End If
          End If
        End If
      End If
    Next j
 ' copy row
  For k = 1 To 38
  outarr(indi, k) = inarr(copi, k)
  Next k
  indi = indi + 1
 End If
 
Next i
With Worksheets("Sheet2")
 Range(.Cells(1, 1), .Cells(indi, 38)) = outarr
End With

End Sub

 

[Maruthiveer]

Hello Thank you so much .
you're correct the row count is in AL.

i tried the above mentioned code like the macro is working totally fine its picking up the needed row but its copying the same row twice . No action has been taken for row count 3. is it limited to only row count 2? . this is the data i gave to run.

ID	Eff Date	Sequence	Row Count
7273	2020-03-20	0​	2​
7273	2020-03-23	0​	2​
4888	2020-03-16	0​	2​
4888	2020-03-16	1​	2​
6080	2020-03-10	0​	2​
6080	2020-03-10	10​	2​
3969	2020-03-17	0​	3​
3969	2020-03-17	10​	3​
3969	2020-03-19	0​	3​
7888	2020-03-16	1	2

the macro gave the result as :

7273​	3/23/2020​	0​	2​
7273​	3/23/2020​	0​	2​
4888​	3/16/2020​	1​	2​
4888​	3/16/2020​	1​	2​
6080​	3/10/2020​	10​	2​
6080​	3/10/2020​	10​	2​
7888​	3/16/2020​	1​	2​

Can this code be edited that it can copy and paste the row only once and can take the same action for another row counts as well .Thank you so much for your efforts .

 

[Maruthiveer]

i have added a code to delete the duplicate rows , and keep only unique values it's working fine for row count =2, , i changed the row count=3 in your code and executed it , now the macro is giving three rows. Do we have any other way for this ? i my view the filter method applies fine for the process .

 

[offthelip]

The reason you are getting two rows copied is because I made an error with the second loop, changing this line should fix the problem:
change:

For j = i To lastrow

to:

For j = i+1 To lastrow

I don't understand what you want with rowcount= 2 and rowcount = 3, please clarify. Do you want to loop through a number of rowcounts if so what range 2 to 100?

 

[Maruthiveer]

Yes i want to loop through the row count, Range of row count would be 2 to 30

 

[offthelip]

that is a very simple change:

Sub test()
Dim outarr()
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(Cells(1, 1), Cells(lastrow, 38)) ' pick A1 to Al lastrow
ReDim outarr(1 To lastrow, 1 To 38)
indi = 2
For rowcnt = 2 To 30
For i = 2 To lastrow
 If inarr(i, 38) = rowcnt Then ' check is AL = rowcnt your requirements are ambiguous I presume row count is in AL
   currentid = inarr(i, 1)
    copi = i
    For j = i To lastrow
      ' look for duplicates
       If inarr(j, 1) = currentid Then
        If copi = i Then  ' check if it is the first duplicate
          copi = j
        Else
         ' check sequnce number AB
          If inarr(j, 28) > inarr(copi, 28) Then
           inarr(copi, 1) = "" ' clear previous duplicate to avoid copying agian
           copi = j
          Else
           ' check if sequnce number equal
                If inarr(j, 28) = inarr(copi, 28) Then
                   ' check dates
                 If inarr(j, 11) > inarr(copi, 11) Then
                    inarr(copi, 1) = "" ' clear previous duplicate to avoid copying agian
                    copi = j
                 End If
                End If
          End If
        End If
      End If
    Next j
 ' copy row
  For k = 1 To 38
  outarr(indi, k) = inarr(copi, k)
  Next k
  indi = indi + 1
 End If
 
Next i
Next rowcnt
With Worksheets("Sheet2")
 Range(.Cells(1, 1), .Cells(indi, 38)) = outarr
End With

End Sub

 

[Maruthiveer]

I have used the above code and also made change for code

For j = i+1 To lastrow

Still the macro is copying the duplicate Id's .

can we use a different approach for this process ., How about the filter method ,

In the master excel sheet (output) with columns "A" to "AL", The column "A" will have ID's,column "k" has date , column "AB" have sequence(0,1,2,3,4..) and column "AL" have row count(2,3,4,5,6..). The column A will have same values sometimes i.e,(Duplicate values).

1. Apply filters and filter row count(AL) =, pick the value i.e (2),
Apply filter for the employee ID 's (A) .

A. Pick the first ID
Check for any duplicate ID's in (coloumn "A")
1..if no duplicate ID's found then copy that row and paste it in sheet2 ( Final Output).
2.If Duplicate ID's found , copy the row with the highest sequence number (AB) to sheet 2.
3.If Duplicate ID's found and the sequence number is also same then copy the row with the date(K),whichever date is recent one that row should be copied and paste in the sheet2.

Pick second employee ID
Check for any duplicate ID's in (coloumn "A")
1..if no duplicate ID's found then copy that row and paste it in sheet2 ( Final Output).
2.If Duplicate ID's found , copy the row with the highest sequence number (AB) to sheet 2.
3.If Duplicate ID's found and the sequence number is also same then copy the row with the date(K),whichever date is recent one that row should be copied and paste in the sheet2.

Repeat the process for all ID's.

and then

Filter to row count (AL)=3.
Apply filter for the employee ID 's (A) .
A. Pick the first ID
Repeat the process of Steps 1,2,3
after doing all the ID's.

go for rount count =4

I am sounding too large but i think this will help , can you write a code in this way ?

Thanks

 

[offthelip]

Is the only problem with the code I wrote for that it copied duplicates? if so try this fix:
change:

' look for duplicates
       If inarr(j, 1) = currentid   Then

to:

' look for duplicates
       If inarr(j, 1) = currentid  and inarr(j,i) <> "" Then

If you really want to try a totally different approach feel free, but I think the way you are describing is the way you would do the job manually and it is a much more complicated way of doing it using VBA
One thing I will point out: my solution will much much faster to execute. Setting filters on every value on two columns going through every value in the column is going to be very very slow!!! This is one of the reasons for doing it the programming way rather than the EXCEL way

 

[Maruthiveer]

Sub test()
Dim outarr()
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(Cells(1, 1), Cells(lastrow, 38)) ' pick A1 to Al lastrow
ReDim outarr(1 To lastrow, 1 To 38)
indi = 2
For rowcnt = 2 To 30
For i = 2 To lastrow
If inarr(i, 38) = rowcnt Then ' check is AL = rowcnt your requirements are ambiguous I presume row count is in AL
currentid = inarr(i, 1)
copi = i
For j = i + 1 To lastrow
' look for duplicates
If inarr(j, 1) = currentid And inarr(j, i) <> "" Then
If copi = i Then ' check if it is the first duplicate
copi = j
Else
' check sequnce number AB
If inarr(j, 28) > inarr(copi, 28) Then
inarr(copi, 1) = "" ' clear previous duplicate to avoid copying agian
copi = j
Else
' check if sequnce number equal
If inarr(j, 28) = inarr(copi, 28) Then
' check dates
If inarr(j, 11) > inarr(copi, 11) Then
inarr(copi, 1) = "" ' clear previous duplicate to avoid copying agian
copi = j
End If
End If
End If
End If
End If
Next j
' copy row
For k = 1 To 38
outarr(indi, k) = inarr(copi, k)
Next k
indi = indi + 1
End If

Next i
Next rowcnt
With Worksheets("Sheet2")
Range(.Cells(1, 1), .Cells(indi, 38)) = outarr
End With

End Sub


I have made changes to the code as you said but its still copying the same .

97273	2020-03-20	0​	2​
97273	2020-03-23	0​	2​
4888	2020-03-16	0​	2​
4888	2020-03-16	1​	2​
6080	2020-03-10	0​	2​
6080	2020-03-10	10​	2​
3969	2020-03-17	0​	3​
3969	2020-03-17	10​	3​
3969	2020-03-19	0​	3​

You can use this data for testing .


Thanks