Jul 03 2022 07:18 AM
Jul 03 2022 07:18 AM
Hope you are all well!
Background: This is my test excel sheet: The duplicates column is created from this excel function: =IF(COUNTIF($A$2:$A2,A2)>1, "Duplicate","").
I will have lots of data where each row has a different email but some rows will be from the same company (eg CoA - A2 & A6). All the data is important.
Overall Aim: I would like to move all the duplicate Co A; Co B; Co C; etc rows to another sheet and then in that sheet move the duplicates into a third sheet and so on. That way I'll have sheet 1 with Co A; Co B; Co C; Co D; etc only once and the same with sheet 2 and so on (i.e. for CoA: the A2 row will be in sheet 1, A6 row will be in sheet 2, A9 row will be in sheet 3 and so on; same with CoB and CoC). In the above example, I'd end up with three sheets.
Ideally, I'd like the code to automatically create a new sheet to move duplicates to and then continue this cycle as there can be up to 70 duplicates for one "Co X" field. So I'd have 70 sheets with one instance of each Co line (all with different emails and other data).
This script allows me to copy the bottom three duplicates into sheet 2, but I have to re-run the code which then takes 2 duplicates over to sheet 2, and then on the third re-run it takes the last remaining duplicate over to sheet 2. In reality, I'll have a lot more data so I'd like it to execute in one run.
'VBA Code to move the entire row if cells in column 4 has the value Duplicate Sub move_rows_to_another_sheet() For Each myCell In Selection.Columns(4).Cells 'Need a for loop iteration If myCell.Value = "Duplicate" Then myCell.EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(3)(2) myCell.EntireRow.delete End If Next End Sub
I realised that the delete line is what is causing the problem. The first Sub copies all the duplicates over to sheet 2, in one run. However, the second sub still only deletes the bottom three duplicates and must be run a total of three times to remove the duplicates. I would prefer to run both subs in one and not have to re-run the delete Sub.
'VBA Codeto movethe entire row if cells in column 4 has the value Duplicate Sub move_rows_to_another_sheet() For Each myCell In Selection.Columns(4).Cells 'Need a for loop iteration If myCell.Value = "Duplicate" Then myCell.EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(3)(2) End If Next End Sub Sub delete_duplicates_in_sheet1() For Each myCell In Selection.Columns(4).Cells 'Need a for loop iteration If myCell.Value = "Duplicate" Then myCell.EntireRow.delete End If Next End Sub
My next steps:
I will be learning how to use a for loop so that I can have the delete Sub execute continuously until all duplicates have been deleted. If anyone knows a better way please let me know.
Any help would be greatly appreciated.
Jul 03 2022 08:57 AM
Sub DellDuplicate() Dim i As Integer Dim intLR As Integer intLR = Sheets("Sheet1").Range("D65536").End(xlUp).Row With Sheets("Sheet1") For i = 1 To intLR If InStr(1, .Cells(i, 4).Value, "Duplicate") Then .Cells(i, 1).EntireRow.Delete i = i - 1 Else End If Next i End With End Sub
Forgive me if I didn't read through your text due to time constraints.
Send you this little code as I could understand it on the fly.
Maybe it helps, if not just ignore it :).
I know I don't know anything (Socrates)
Jul 03 2022 11:14 AM