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

Maruthiveer

New Member
Joined
Apr 12, 2020
Messages
15
Office Version
  1. 2016
  2. 2013
  3. 2011
  4. 2010
  5. 2007
Platform
  1. Windows
  2. Mobile
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 ..
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
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:
VBA Code:
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
 
Upvote 0
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.

IDEff DateSequenceRow Count
72732020-03-20
0​
2​
72732020-03-23
0​
2​
48882020-03-16
0​
2​
48882020-03-16
1​
2​
60802020-03-10
0​
2​
60802020-03-10
10​
2​
39692020-03-17
0​
3​
39692020-03-17
10​
3​
39692020-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 .
 
Upvote 0
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 .
 
Upvote 0
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:
VBA Code:
For j = i To lastrow
to:
Code:
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?
 
Upvote 0
Yes i want to loop through the row count, Range of row count would be 2 to 30
 
Upvote 0
that is a very simple change:
VBA Code:
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
 
Upvote 0
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
 
Upvote 0
Is the only problem with the code I wrote for that it copied duplicates? if so try this fix:
change:
VBA Code:
' look for duplicates
       If inarr(j, 1) = currentid   Then
to:
Code:
' 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
 
Upvote 0
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 .


972732020-03-20
0​
2​
972732020-03-23
0​
2​
48882020-03-16
0​
2​
48882020-03-16
1​
2​
60802020-03-10
0​
2​
60802020-03-10
10​
2​
39692020-03-17
0​
3​
39692020-03-17
10​
3​
39692020-03-19
0​
3​

You can use this data for testing .


Thanks
 
Upvote 0

Forum statistics

Threads
1,223,230
Messages
6,170,883
Members
452,364
Latest member
springate

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top