Removing Duplicate Value

[Karan001]

Hi Experts,
I want keep only single value from the below given Column with two row.Please tell me how to get the same.

<table style="width: 328px; height: 96px;" border="0" cellpadding="0" cellspacing="0"><col style="width: 167pt;" width="222"> <tbody><tr style="height: 12.75pt;" height="17"> <td class="xl66" style="height: 12.75pt; width: 167pt;" height="17" width="222"> Column-1
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl65" style="height: 12.75pt; border-top: medium none;" height="17">1Week/5Weeks/4Weeks/4Weeks</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl65" style="height: 12.75pt; border-top: medium none;" height="17">1Week/2Weeks/4Weeks/2Weeks</td> </tr> </tbody></table>

I want to keep only single value as shown below

<table style="width: 346px; height: 102px;" border="0" cellpadding="0" cellspacing="0"><col style="width: 167pt;" width="222"> <tbody><tr style="height: 12.75pt;" height="17"> <td class="xl66" style="height: 12.75pt; width: 167pt;" height="17" width="222"> Column-1
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl65" style="height: 12.75pt; border-top: medium none;" height="17">1Week/5Weeks/4Weeks</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl65" style="height: 12.75pt; border-top: medium none;" height="17">1Week/2Weeks/4Weeks</td></tr></tbody></table>

Regards,
Karan

 

[MrKowz]

Karan,

Try:

Public Sub RemoveDupValues()
Dim i   As Long, _
    j   As Long, _
    LR  As Long, _
    tmp As Variant, _
    str As String
 
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    tmp = Split(Range("A" & i).Value, "/")
    For j = 0 To UBound(tmp)
        If InStr(str, tmp(j)) = 0 Then
            str = str & tmp(j) & "/"
        End If
    Next j
    str = Left(str, Len(str) - 1)
    Range("A" & i).Value = str
    str = vbNullString
Next i
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

<b>Excel 2007</b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #A6AAB6"><colgroup><col width="25px" style="background-color: #E0E0F0" /><col /><col /></colgroup><thead><tr style=" background-color: #E0E0F0;text-align: center;color: #161120"><th></th><th>A</th><th>B</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">1</td><td style=";">Before Macro</td><td style=";">After Macro</td></tr><tr ><td style="color: #161120;text-align: center;">2</td><td style=";">1Week/5Weeks/4Weeks/4Weeks</td><td style=";">1Week/5Weeks/4Weeks</td></tr><tr ><td style="color: #161120;text-align: center;">3</td><td style=";">1Week/2Weeks/4Weeks/2Weeks</td><td style=";">1Week/2Weeks/4Weeks</td></tr></tbody></table><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #A6AAB6"><thead><tr style="background-color: #E0E0F0;text-align: center;color: #161120"><th><b>Sheet2</b></th></tr></td></thead></table><br /><br />

 

[VoG]

Try

Sub DelDups()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 1 Step -1
    If Application.CountIf(Columns("A"), Range("A" & i).Value) > 1 Then Rows(i).Delete
Next i
End Sub

 

[Karan001]

Hi MrKowz,

I tried your tips and it is working excellent for the my requirement.
Thanks for your valuable input.

Hi Peter,
You too thanks for your reply but i tried that and didnt work.Anyway i got the solution and it is working fine.

Regards,

Karan

 

[Karan001]

Hi Mr. Kowz,
I tried your above code it is working fine but i am facing problem applying at below data as shown below :

<TABLE style="WIDTH: 138pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=184><COLGROUP><COL style="WIDTH: 138pt; mso-width-source: userset; mso-width-alt: 6729" width=184><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: yellow; WIDTH: 138pt; HEIGHT: 15pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=20 width=184>24Weeks/4Weeks/24Weeks</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: yellow; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=20>4Weeks/24Weeks/24Weeks</TD></TR></TBODY></TABLE>


After apply the codes system removed 4 weeks from the first row can you just modify the codes so that it should not be happened.

i am getting result after applying the code which is not correct ,please support me how to correct this.

<TABLE style="WIDTH: 146pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=194><COLGROUP><COL style="WIDTH: 146pt; mso-width-source: userset; mso-width-alt: 7094" width=194><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 146pt; HEIGHT: 15pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20 width=194>24Weeks</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20>4Weeks/24Weeks</TD></TR></TBODY></TABLE>


Regards,
Karan

 

[Krishnakumar]

Hi,

Try this UDF

Function KARAN(ByRef r As Range) As String
Dim x, i As Long
With CreateObject("scripting.dictionary")
    .comparemode = 1
    x = Split(r.Value, "/")
    For i = 0 To UBound(x)
        .Item(x(i)) = Empty
    Next
    If .Count Then KARAN = Join(.keys, "/")
End With
End Function

use like

=KARAN(A1)

HTH

 

[Karan001]

Hi Krishna,
Thanks for the reply it is working fine.

Regds,
Karan