Remove duplicate rows macro

[LT_Orange]

Hello All,

I work at a test lab and i have over 500,000 test records. I need to remove the duplicate record rows. The file has this layout. A patient can have multiple test and on rare cases have a different case number.
[TABLE="width: 500"]
<tbody>[TR]
[TD]Case Number[/TD]
[TD]Patient Name[/TD]
[TD]Test[/TD]
[TD]Patient ID[/TD]
[/TR]
[TR]
[TD]1011[/TD]
[TD]John Smith[/TD]
[TD]ABC123[/TD]
[TD]5555[/TD]
[/TR]
[TR]
[TD]1011[/TD]
[TD]John Smith[/TD]
[TD]ABC123[/TD]
[TD]5555
[/TD]
[/TR]
[TR]
[TD]1014[/TD]
[TD]Jane Doe[/TD]
[TD]YHF162[/TD]
[TD]5512[/TD]
[/TR]
[TR]
[TD]1014[/TD]
[TD]Jane Doe[/TD]
[TD]BRAC21[/TD]
[TD]5512[/TD]
[/TR]
[TR]
[TD]1032[/TD]
[TD]Jane Doe[/TD]
[TD]JFEH12[/TD]
[TD]5512[/TD]
[/TR]
[TR]
[TD]1014[/TD]
[TD]Jane Doe[/TD]
[TD]YHF162[/TD]
[TD]5512[/TD]
[/TR]
[TR]
[TD]1014[/TD]
[TD]Jane Doe[/TD]
[TD]BRAC21[/TD]
[TD]5512[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Case Number[/TD]
[TD]Patient Name[/TD]
[TD]Test[/TD]
[TD]Patient ID[/TD]
[/TR]
[TR]
[TD]1011[/TD]
[TD]John Smith[/TD]
[TD]ABC123[/TD]
[TD]5555[/TD]
[/TR]
[TR]
[TD]1014[/TD]
[TD]Jane Doe[/TD]
[TD]YHF162[/TD]
[TD]5512[/TD]
[/TR]
[TR]
[TD]1014[/TD]
[TD]Jane Doe[/TD]
[TD]BRAC32[/TD]
[TD]5512[/TD]
[/TR]
[TR]
[TD]1032[/TD]
[TD]Jane Doe[/TD]
[TD]JFEH12[/TD]
[TD]5512[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I want to create a macro that will give me this result.

I have the following.

Sub SameLine ()

Dim x as long
Dim y as long
Dim Test as long

test = cells.find (what:="Test", LookIn =:xlformulas, lookAt:=xlPart, searchOrder=:xLByRow, SearchDirection:=XlNext, MatchCase:=false_, SearchFormat=:false).column
Dim VarStart as Long 
varstart = cells.find (what:="Case Number", LookIn =:xlformulas, lookAt:=xlPart, searchOrder=:xLByRow, SearchDirection:=XlNext, MatchCase:=false_, SearchFormat=:false).column

dim varend as long
varend = 0
do while cells (x,1).value <> ""
y=y +varend +2
rows(x+1).delete
x=x+1
loop
end sub

This code only gives me the following records.

[TABLE="width: 500"]
<tbody>[TR]
[TD]1011[/TD]
[TD]John Smith[/TD]
[TD]ABC123[/TD]
[TD]5555[/TD]
[/TR]
[TR]
[TD]1011[/TD]
[TD]John Smith[/TD]
[TD]ABC123[/TD]
[TD]5555[/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="width: 500"]
<tbody>[TR]
[TD]1014[/TD]
[TD]Jane Doe[/TD]
[TD]YHF162[/TD]
[TD]5512[/TD]
[/TR]
</tbody>[/TABLE]


Thanks in advance.

 

[Takae]

Please make a "sheet2".
Sheet1 has data and sheet2 will have result.

Sub sample()
    Dim Dic, i As Long, LR As Long
    Dim buf As String, keys
    Set Dic = CreateObject("scripting.Dictionary")
    On Error Resume Next
    With Sheets("sheet1")
        LR = .cells(Rows.Count, 1).End(xlUp).row
        For i = 2 To LR
            buf = .cells(i, 1).Value & "_" & .cells(i, 2).Value & "_" & .cells(i, 3).Value & "_" & .cells(i, 4).Value
            Dic.Add buf, buf
        Next
    End With
    keys = Dic.keys
    With Sheets("sheet2")
        For i = 0 To Dic.Count - 1
            .Range(.cells(i + 1, 1), .cells(i + 1, 4)) = split(keys(i), "_")
        Next
    End With
    Set Dic = Nothing
End Sub

 

[alansidman]

If you are using an excel version of 2007 or later, there is a built in function on the ribbon that will do this for you. Click on the Data Tab and look for Remove Duplicates function.

 

[kalak]

If you are using an excel version of 2007 or later, there is a built in function on the ribbon that will do this for you. Click on the Data Tab and look for Remove Duplicates function.

Sorry Alan, but it sometimes doesn't.
Unless you have a way of guaranteeing reliability of the Remove Duplicates function its use is better avoided.
For example, try it on the following data set, and if you like report your results.
[TABLE="width: 115"]
<tbody>[TR]
[TD="align: center"]4[/TD]
[TD="align: center"][/TD]
[TD="align: center"]x[/TD]
[/TR]
[TR]
[TD="align: center"]10[/TD]
[TD="align: center"][/TD]
[TD="align: center"]10[/TD]
[/TR]
[TR]
[TD="align: center"]10x[/TD]
[TD="align: center"][/TD]
[TD="align: center"]4[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"][/TD]
[TD="align: center"]4[/TD]
[/TR]
[TR]
[TD="align: center"]10[/TD]
[TD="align: center"][/TD]
[TD="align: center"]10[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"][/TD]
[TD="align: center"]x[/TD]
[/TR]
</tbody>[/TABLE]