Macro for duplicates and move rows

Question

Hello,

I have an excel sheet with around 20,000 rows of data with multiple columns. One column contains the account number

and there are multiple rows of data having the same account number on this sheet.

First, I need to find duplicate rows having same account number then, leave one row on the sheet and move rest of

the rows into a new sheet on the workbook.

If I have the code for the above, I can run the same macro on the new sheets recursively until I have several

sheets with non duplicate data.

Any help is greatly appreciated!

Thanks in advance!

Answer 1

Jonathan_JA,

this assumes you data starts in row 2 with headers in row 1 so that the first header is in A1 and that you have headers out to the last column in row 1.

it adds a sheet on the end of the tab order for the duplicate rows.

make the sheet you want to process the activesheet before you run the macro.   So you can run this recursively.

Test is on a copy of your workbook to be sure it does what you want.

Sub abc()

Dim sCol As String, sh As Worksheet

Dim r As Range, cell As Range, lastColumn As Long

sCol = "E"   ' column with account number

Set sh = ActiveSheet

Set r = sh.Range(sCol & "2", sh.Cells(sh.Rows.Count, sCol).End(xlUp))

lcol = sh.Cells(1, sh.Columns.Count).End(xlToLeft).Column

Set r1 = r.Offset(0, lcol - r.Column + 1)

sform = "$" & sCol & "$" & 2 & ":" & "$" & sCol & 2

r1.Formula = "=Countif(" & sform & ",$" & sCol & 2 & ")"

r1.Formula = r1.Value

sh.Cells(1, r1.Column).Value = "HeaderZZZ"

On Error Resume Next

 sh.ShowAllData

On Error GoTo 0

sh.Copy after:=Worksheets(Worksheets.Count)

Set sh1 = ActiveSheet

sh.Range("A1").CurrentRegion.AutoFilter Field:=r1.Column, Criteria1:="<>1"

Set r2 = sh.AutoFilter.Range

Set r2 = r2.Offset(1, 0).Resize(, 1)

Set r4 = sh1.Range(r2.Address)

sh1.Range("A1").CurrentRegion.AutoFilter Field:=r1.Column, Criteria1:="=1"

On Error Resume Next

  Set r3 = r2.SpecialCells(xlVisible)

  r3.EntireRow.Delete

  Set r3 = Nothing

  Set r3 = r4.SpecialCells(xlVisible)

  Application.Goto r3

  r3.EntireRow.Delete

  sh.AutoFilterMode = False

  sh1.AutoFilterMode = False

  sh1.Columns(r1.Column).EntireColumn.Delete

  r1.EntireColumn.Delete

On Error GoTo 0

End Sub

--

Regards,

Tom Ogilvy

Answer 2

So I know this is an old POST but hoping you might be able to help. I am looking for a way or macro that will do the opposite of this...

I have a file that has a row for every entry, but I need to have one roll per client with their account numbers for each client.

Example:

The file has a column for client, email and account number. One client may have 4-5 different account numbers, so for each account number there is a row with client, email and account.

We want to modify this sheet to have one row for the client, email and then have a column for each account number the client has so there is only one row/record per client.

Is it possible to script this in a macro???

Thanks!

Trevor

Answer 3

Hi Tom,

I ran the macro on actual data set and its working!!

Thanks again for your help.

Kind Regards

Jonathan_JA

Answer 4

Thanks a lot Tom,

I tried the macro with a sample set of data, it worked!! Nice one.

I will try this with the real set of data and will let you know.

Many Thanks

Jonathan_JA

Answer 5

How many duplicates can one account have? Do you want the final sheet to have one entry for every account that appeared originally? How do you determine which row to leave and which rows to move (by date, maybe?)?

Bernie