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.

Case Number	Patient Name	Test	Patient ID
1011	John Smith	ABC123	5555
1011	John Smith	ABC123	5555
1014	Jane Doe	YHF162	5512
1014	Jane Doe	BRAC21	5512
1032	Jane Doe	JFEH12	5512
1014	Jane Doe	YHF162	5512
1014	Jane Doe	BRAC21	5512
Case Number	Patient Name	Test	Patient ID
1011	John Smith	ABC123	5555
1014	Jane Doe	YHF162	5512
1014	Jane Doe	BRAC32	5512
1032	Jane Doe	JFEH12	5512

<tbody>
</tbody>

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.

1011	John Smith	ABC123	5555
1011	John Smith	ABC123	5555

<tbody>
</tbody>

1014

Jane Doe

YHF162

5512

<tbody>
</tbody>

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.

4		x
10		10
10x		4
4		4
10		10
4		x

<tbody>
</tbody>