Hi

Would kindly request you to help for the following:

1) I need a VBA Code to detect the duplicates based on below data. Have
given my comments in Column D for for more information.
2) After checking Column B with Column A & Column C the duplicates should be
detleted & should pop a message box that these many duplicates deleted. In
below mentioned Eg. the message box should display " Total Duplicated
Detected:2 , Unique Records:4"
__________________________________________________________

EG:

Column A ColumnB ColumnC Column D
COMPANY NAME PROSPECT NAME TITLE COMMENTS
Wachovia David Wishon SVP Not a duplicate
Wachovia David Wishon Associate Not a duplicate
Bank Of America Uma Nandan Researcher Not a duplicate
Citigroup Uma Nandan Researcher Not a duplicate
Wachovia David Wishon Associate Duplicate. Need to
delete
Bank Of America Uma Nandan Researcher Duplicate. Need to delete

_____________________________________________________________
Would appreciate if some one can help me with this. I have a data of 50,000
to perform this task.

Thanks in advance.

Regards,
Uma

Uma,

Sub UmaMacro()
Dim myR As Long
Dim myC As Range
Dim myR2 As Long

myR = Cells(Rows.Count, 1).End(xlUp).Row
Range("D2").EntireColumn.Insert

With Range("D2" & myR)
.FormulaR1C1 = _
"=SUMPRODUCT((RC[-3]=R2C1:RC1)*(RC[-2]=R2C2:RC2)*(RC[-1]=R2C3:RC3))"
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Range("D1").Value = "Sort"
Range("A1" & myR).Sort Key1:=Range("D2"), _
Order1:=xlAscending, Header:= xlYes
Set myC = Columns("D").Find(What:="2")
Range(myC, Cells(myR, 4)).EntireRow.Delete
Range("D2").EntireColumn.Delete
myR2 = Cells(Rows.Count, 1).End(xlUp).Row
MsgBox "I deleted " & myR - myR2 & " and there were " _
& myR2 - 1 & " that I did not delete."
End Sub

HTH,
Bernie
MS Excel MVP


"Uma Nandan" <(E-Mail Removed)> wrote in message
news:E5AC0CF3-32C6-49F4-AC7E-(E-Mail Removed)...
> Hi
>
> Would kindly request you to help for the following:
>
> 1) I need a VBA Code to detect the duplicates based on below data. Have
> given my comments in Column D for for more information.
> 2) After checking Column B with Column A & Column C the duplicates should be
> detleted & should pop a message box that these many duplicates deleted. In
> below mentioned Eg. the message box should display " Total Duplicated
> Detected:2 , Unique Records:4"
> __________________________________________________________
>
> EG:
>
> Column A ColumnB ColumnC Column D
> COMPANY NAME PROSPECT NAME TITLE COMMENTS
> Wachovia David Wishon SVP Not a duplicate
> Wachovia David Wishon Associate Not a duplicate
> Bank Of America Uma Nandan Researcher Not a duplicate
> Citigroup Uma Nandan Researcher Not a duplicate
> Wachovia David Wishon Associate Duplicate. Need to
> delete
> Bank Of America Uma Nandan Researcher Duplicate. Need to delete
>
> _____________________________________________________________
> Would appreciate if some one can help me with this. I have a data of 50,000
> to perform this task.
>
> Thanks in advance.
>
> Regards,
> Uma

Hi Uma

Try this:

Sub DeleteDuplicates()
Dim StartCell As Range
Dim LastCell As Range
Dim NoOfRec As Long
Dim NoOfUniq As Long
Dim NoOfDup As Long
Dim TempSh As Worksheet
Dim FilterSh As Worksheet

Application.ScreenUpdating = False

Set FilterSh = Worksheets("Sheet1")
Set TempSh = Worksheets.Add
FilterSh.Activate
Set StartCell = Range("A1")
Set LastCell = StartCell.End(xlDown)
NoOfRec = LastCell.Row - StartCell.Row

FilterSh.Range(StartCell, LastCell.Offset(0, 2)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=TempSh.Range( _
"A1"), Unique:=True

NoOfUniq = TempSh.Range("A2", TempSh.Range("A2").End
(xlDown)).Rows.Count
NoOfDup = NoOfRec - NoOfUniq

FilterSh.Range(StartCell, LastCell.Offset(0, 2)).Delete
With TempSh
.Range("A1", .Range("A1").End(xlDown).Offset(0, 2)).Copy _
Destination:=FilterSh.Range("A1")
End With

With Application
.DisplayAlerts = False
TempSh.Delete
.DisplayAlerts = True
.ScreenUpdating = True
End With
Msg = MsgBox("Total Duplicated Detected: " & NoOfDup & vbLf & vbLf _
& "Unique Records: " & NoOfUniq, vbInformation, "Hello")
End Sub

Regards,
Per

On 19 Nov., 17:28, Uma Nandan <UmaNan...@discussions.microsoft.com>
wrote:
> Hi
>
> Would kindly request you to help for the following:
>
> 1) I need a VBA Code to detect the duplicates based on below data. Have
> given my comments in Column D for for more information.
> 2) After checking Column B with Column A & Column C the duplicates shouldbe
> detleted & should pop a message box that these many duplicates deleted. In
> below mentioned Eg. the message box should display " Total Duplicated
> Detected:2 , Unique Records:4"
> __________________________________________________________
>
> EG:
>
> * * * Column A * * * * * * * *ColumnB * * * * * * *ColumnC * * * Column D
> COMPANY NAME * *PROSPECT NAME * * TITLE COMMENTS
> Wachovia * * * * * * * * * * * *David Wishon * * * * * SVP * * *Not a duplicate
> Wachovia * * * * * * * * * * * *David Wishon * * * * * Associate * * * *Not a duplicate
> Bank Of America Uma Nandan * * * * * *Researcher * * * *Not a duplicate
> Citigroup * * * * * * * * * * * Uma Nandan * * * * * *Researcher * * * *Not a duplicate
> Wachovia * * * * * * * * * * * *David Wishon * * * * * Associate * * * *Duplicate. Need to
> delete
> Bank Of America Uma Nandan * * * * * *Researcher * * * *Duplicate. Need to delete
>
> _____________________________________________________________
> Would appreciate if some one can help me with this. I have a data of 50,000
> to perform this task.
>
> Thanks in advance.
>
> Regards,
> Uma

Hi Bernie,

Thanks for your quick response.
This works fantastic. However if there is no duplicates, i get a runtime
Error.
So is there any way to do something for that.

thank you so much once again

Regards,
Uma

"Bernie Deitrick" wrote:

> Uma,
>
> Sub UmaMacro()
> Dim myR As Long
> Dim myC As Range
> Dim myR2 As Long
>
> myR = Cells(Rows.Count, 1).End(xlUp).Row
> Range("D2").EntireColumn.Insert
>
> With Range("D2" & myR)
> .FormulaR1C1 = _
> "=SUMPRODUCT((RC[-3]=R2C1:RC1)*(RC[-2]=R2C2:RC2)*(RC[-1]=R2C3:RC3))"
> .Copy
> .PasteSpecial Paste:=xlPasteValues
> End With
> Range("D1").Value = "Sort"
> Range("A1" & myR).Sort Key1:=Range("D2"), _
> Order1:=xlAscending, Header:= xlYes
> Set myC = Columns("D").Find(What:="2")
> Range(myC, Cells(myR, 4)).EntireRow.Delete
> Range("D2").EntireColumn.Delete
> myR2 = Cells(Rows.Count, 1).End(xlUp).Row
> MsgBox "I deleted " & myR - myR2 & " and there were " _
> & myR2 - 1 & " that I did not delete."
> End Sub
>
> HTH,
> Bernie
> MS Excel MVP
>
>
> "Uma Nandan" <(E-Mail Removed)> wrote in message
> news:E5AC0CF3-32C6-49F4-AC7E-(E-Mail Removed)...
> > Hi
> >
> > Would kindly request you to help for the following:
> >
> > 1) I need a VBA Code to detect the duplicates based on below data. Have
> > given my comments in Column D for for more information.
> > 2) After checking Column B with Column A & Column C the duplicates should be
> > detleted & should pop a message box that these many duplicates deleted. In
> > below mentioned Eg. the message box should display " Total Duplicated
> > Detected:2 , Unique Records:4"
> > __________________________________________________________
> >
> > EG:
> >
> > Column A ColumnB ColumnC Column D
> > COMPANY NAME PROSPECT NAME TITLE COMMENTS
> > Wachovia David Wishon SVP Not a duplicate
> > Wachovia David Wishon Associate Not a duplicate
> > Bank Of America Uma Nandan Researcher Not a duplicate
> > Citigroup Uma Nandan Researcher Not a duplicate
> > Wachovia David Wishon Associate Duplicate. Need to
> > delete
> > Bank Of America Uma Nandan Researcher Duplicate. Need to delete
> >
> > _____________________________________________________________
> > Would appreciate if some one can help me with this. I have a data of 50,000
> > to perform this task.
> >
> > Thanks in advance.
> >
> > Regards,
> > Uma
>
>
>

Hi Per,

Thanks of your code.
However this code is showing me compile Error at the following:

NoOfUniq = TempSh.Range("A2", TempSh.Range("A2").End
(xlDown)).Rows.Count

I wasnt' able to run the code cause of the error.

Regards,
Uma


"Per Jessen" wrote:

> Hi Uma
>
> Try this:
>
> Sub DeleteDuplicates()
> Dim StartCell As Range
> Dim LastCell As Range
> Dim NoOfRec As Long
> Dim NoOfUniq As Long
> Dim NoOfDup As Long
> Dim TempSh As Worksheet
> Dim FilterSh As Worksheet
>
> Application.ScreenUpdating = False
>
> Set FilterSh = Worksheets("Sheet1")
> Set TempSh = Worksheets.Add
> FilterSh.Activate
> Set StartCell = Range("A1")
> Set LastCell = StartCell.End(xlDown)
> NoOfRec = LastCell.Row - StartCell.Row
>
> FilterSh.Range(StartCell, LastCell.Offset(0, 2)).AdvancedFilter _
> Action:=xlFilterCopy, CopyToRange:=TempSh.Range( _
> "A1"), Unique:=True
>
> NoOfUniq = TempSh.Range("A2", TempSh.Range("A2").End
> (xlDown)).Rows.Count
> NoOfDup = NoOfRec - NoOfUniq
>
> FilterSh.Range(StartCell, LastCell.Offset(0, 2)).Delete
> With TempSh
> .Range("A1", .Range("A1").End(xlDown).Offset(0, 2)).Copy _
> Destination:=FilterSh.Range("A1")
> End With
>
> With Application
> .DisplayAlerts = False
> TempSh.Delete
> .DisplayAlerts = True
> .ScreenUpdating = True
> End With
> Msg = MsgBox("Total Duplicated Detected: " & NoOfDup & vbLf & vbLf _
> & "Unique Records: " & NoOfUniq, vbInformation, "Hello")
> End Sub
>
> Regards,
> Per
>
> On 19 Nov., 17:28, Uma Nandan <UmaNan...@discussions.microsoft.com>
> wrote:
> > Hi
> >
> > Would kindly request you to help for the following:
> >
> > 1) I need a VBA Code to detect the duplicates based on below data. Have
> > given my comments in Column D for for more information.
> > 2) After checking Column B with Column A & Column C the duplicates should be
> > detleted & should pop a message box that these many duplicates deleted. In
> > below mentioned Eg. the message box should display " Total Duplicated
> > Detected:2 , Unique Records:4"
> > __________________________________________________________
> >
> > EG:
> >
> > Column A ColumnB ColumnC Column D
> > COMPANY NAME PROSPECT NAME TITLE COMMENTS
> > Wachovia David Wishon SVP Not a duplicate
> > Wachovia David Wishon Associate Not a duplicate
> > Bank Of America Uma Nandan Researcher Not a duplicate
> > Citigroup Uma Nandan Researcher Not a duplicate
> > Wachovia David Wishon Associate Duplicate. Need to
> > delete
> > Bank Of America Uma Nandan Researcher Duplicate. Need to delete
> >
> > _____________________________________________________________
> > Would appreciate if some one can help me with this. I have a data of 50,000
> > to perform this task.
> >
> > Thanks in advance.
> >
> > Regards,
> > Uma
>
>

Hi Uma

Thanks for your reply.

I think the problem is due to word wrap in your news reader.

The two lines mentioned shall be one line in the macro editor.

Hopes it helps.

Regards,
Per

On 19 Nov., 20:36, Uma Nandan <UmaNan...@discussions.microsoft.com>
wrote:
> Hi Per,
>
> Thanks of your code.
> However this code is showing me compile Error at the following:
>
> NoOfUniq = TempSh.Range("A2", TempSh.Range("A2").End
> (xlDown)).Rows.Count
>
> I wasnt' able to run the code cause of the error.
>
> Regards,
> Uma
>
>
>
> "Per Jessen" wrote:
> > Hi Uma
>
> > Try this:
>
> > Sub DeleteDuplicates()
> > Dim StartCell As Range
> > Dim LastCell As Range
> > Dim NoOfRec As Long
> > Dim NoOfUniq As Long
> > Dim NoOfDup As Long
> > Dim TempSh As Worksheet
> > Dim FilterSh As Worksheet
>
> > Application.ScreenUpdating = False
>
> > Set FilterSh = Worksheets("Sheet1")
> > Set TempSh = Worksheets.Add
> > FilterSh.Activate
> > Set StartCell = Range("A1")
> > Set LastCell = StartCell.End(xlDown)
> > NoOfRec = LastCell.Row - StartCell.Row
>
> > FilterSh.Range(StartCell, LastCell.Offset(0, 2)).AdvancedFilter _
> > * * Action:=xlFilterCopy, CopyToRange:=TempSh.Range( _
> > * * "A1"), Unique:=True
>
> > NoOfUniq = TempSh.Range("A2", TempSh.Range("A2").End
> > (xlDown)).Rows.Count
> > NoOfDup = NoOfRec - NoOfUniq
>
> > FilterSh.Range(StartCell, LastCell.Offset(0, 2)).Delete
> > With TempSh
> > * * .Range("A1", .Range("A1").End(xlDown).Offset(0, 2)).Copy _
> > * * * * Destination:=FilterSh.Range("A1")
> > End With
>
> > With Application
> > * * .DisplayAlerts = False
> > * * TempSh.Delete
> > * * .DisplayAlerts = True
> > * * .ScreenUpdating = True
> > End With
> > Msg = MsgBox("Total Duplicated Detected: " & NoOfDup & vbLf & vbLf _
> > * * & "Unique Records: " & NoOfUniq, vbInformation, "Hello")
> > End Sub
>
> > Regards,
> > Per
>
> > On 19 Nov., 17:28, Uma Nandan <UmaNan...@discussions.microsoft.com>
> > wrote:
> > > Hi
>
> > > Would kindly request you to help for the following:
>
> > > 1) I need a VBA Code to detect the duplicates based on below data. Have
> > > given my comments in Column D for for more information.
> > > 2) After checking Column B with Column A & Column C the duplicates should be
> > > detleted & should pop a message box that these many duplicates deleted. In
> > > below mentioned Eg. the message box should display " Total Duplicated
> > > Detected:2 , Unique Records:4"
> > > __________________________________________________________
>
> > > EG:
>
> > > * * * Column A * * * * * * * *ColumnB * * * * * * *ColumnC * * * Column D
> > > COMPANY NAME * *PROSPECT NAME * * TITLE COMMENTS
> > > Wachovia * * * * * * * * * * * *David Wishon * * * * * SVP * * *Not a duplicate
> > > Wachovia * * * * * * * * * * * *David Wishon * * * * * Associate * * * *Not a duplicate
> > > Bank Of America Uma Nandan * * * * * *Researcher * * * *Not a duplicate
> > > Citigroup * * * * * * * * * * * Uma Nandan * * * * * *Researcher * * * *Not a duplicate
> > > Wachovia * * * * * * * * * * * *David Wishon * * * * * Associate * * * *Duplicate. Need to
> > > delete
> > > Bank Of America Uma Nandan * * * * * *Researcher * * * *Duplicate. Need to delete
>
> > > _____________________________________________________________
> > > Would appreciate if some one can help me with this. I have a data of 50,000
> > > to perform this task.
>
> > > Thanks in advance.
>
> > > Regards,
> > > Uma- Skjul tekst i anførselstegn -
>
> - Vis tekst i anførselstegn -

After the line

Set myC = Columns("D").Find(What:="2")

put the line

On Error Resume Next


Bernie

"Uma Nandan" <(E-Mail Removed)> wrote in message
news:2BA4CD06-56DF-43E2-A1CF-(E-Mail Removed)...
> Hi Bernie,
>
> Thanks for your quick response.
> This works fantastic. However if there is no duplicates, i get a runtime
> Error.
> So is there any way to do something for that.
>
> thank you so much once again
>
> Regards,
> Uma
>
> "Bernie Deitrick" wrote:
>
>> Uma,
>>
>> Sub UmaMacro()
>> Dim myR As Long
>> Dim myC As Range
>> Dim myR2 As Long
>>
>> myR = Cells(Rows.Count, 1).End(xlUp).Row
>> Range("D2").EntireColumn.Insert
>>
>> With Range("D2" & myR)
>> .FormulaR1C1 = _
>> "=SUMPRODUCT((RC[-3]=R2C1:RC1)*(RC[-2]=R2C2:RC2)*(RC[-1]=R2C3:RC3))"
>> .Copy
>> .PasteSpecial Paste:=xlPasteValues
>> End With
>> Range("D1").Value = "Sort"
>> Range("A1" & myR).Sort Key1:=Range("D2"), _
>> Order1:=xlAscending, Header:= xlYes
>> Set myC = Columns("D").Find(What:="2")
>> Range(myC, Cells(myR, 4)).EntireRow.Delete
>> Range("D2").EntireColumn.Delete
>> myR2 = Cells(Rows.Count, 1).End(xlUp).Row
>> MsgBox "I deleted " & myR - myR2 & " and there were " _
>> & myR2 - 1 & " that I did not delete."
>> End Sub
>>
>> HTH,
>> Bernie
>> MS Excel MVP
>>
>>
>> "Uma Nandan" <(E-Mail Removed)> wrote in message
>> news:E5AC0CF3-32C6-49F4-AC7E-(E-Mail Removed)...
>> > Hi
>> >
>> > Would kindly request you to help for the following:
>> >
>> > 1) I need a VBA Code to detect the duplicates based on below data. Have
>> > given my comments in Column D for for more information.
>> > 2) After checking Column B with Column A & Column C the duplicates
>> > should be
>> > detleted & should pop a message box that these many duplicates deleted.
>> > In
>> > below mentioned Eg. the message box should display " Total Duplicated
>> > Detected:2 , Unique Records:4"
>> > __________________________________________________________
>> >
>> > EG:
>> >
>> > Column A ColumnB ColumnC Column
>> > D
>> > COMPANY NAME PROSPECT NAME TITLE COMMENTS
>> > Wachovia David Wishon SVP Not a duplicate
>> > Wachovia David Wishon Associate Not a
>> > duplicate
>> > Bank Of America Uma Nandan Researcher Not a duplicate
>> > Citigroup Uma Nandan Researcher Not a
>> > duplicate
>> > Wachovia David Wishon Associate Duplicate.
>> > Need to
>> > delete
>> > Bank Of America Uma Nandan Researcher Duplicate. Need to
>> > delete
>> >
>> > _____________________________________________________________
>> > Would appreciate if some one can help me with this. I have a data of
>> > 50,000
>> > to perform this task.
>> >
>> > Thanks in advance.
>> >
>> > Regards,
>> > Uma
>>
>>
>>

Hi Bernie,

You saved me by helping with this following code.
Thank you so much :-)

Regards,
Uma

"Bernie Deitrick" wrote:

> After the line
>
> Set myC = Columns("D").Find(What:="2")
>
> put the line
>
> On Error Resume Next
>
>
> Bernie
>
> "Uma Nandan" <(E-Mail Removed)> wrote in message
> news:2BA4CD06-56DF-43E2-A1CF-(E-Mail Removed)...
> > Hi Bernie,
> >
> > Thanks for your quick response.
> > This works fantastic. However if there is no duplicates, i get a runtime
> > Error.
> > So is there any way to do something for that.
> >
> > thank you so much once again
> >
> > Regards,
> > Uma
> >
> > "Bernie Deitrick" wrote:
> >
> >> Uma,
> >>
> >> Sub UmaMacro()
> >> Dim myR As Long
> >> Dim myC As Range
> >> Dim myR2 As Long
> >>
> >> myR = Cells(Rows.Count, 1).End(xlUp).Row
> >> Range("D2").EntireColumn.Insert
> >>
> >> With Range("D2" & myR)
> >> .FormulaR1C1 = _
> >> "=SUMPRODUCT((RC[-3]=R2C1:RC1)*(RC[-2]=R2C2:RC2)*(RC[-1]=R2C3:RC3))"
> >> .Copy
> >> .PasteSpecial Paste:=xlPasteValues
> >> End With
> >> Range("D1").Value = "Sort"
> >> Range("A1" & myR).Sort Key1:=Range("D2"), _
> >> Order1:=xlAscending, Header:= xlYes
> >> Set myC = Columns("D").Find(What:="2")
> >> Range(myC, Cells(myR, 4)).EntireRow.Delete
> >> Range("D2").EntireColumn.Delete
> >> myR2 = Cells(Rows.Count, 1).End(xlUp).Row
> >> MsgBox "I deleted " & myR - myR2 & " and there were " _
> >> & myR2 - 1 & " that I did not delete."
> >> End Sub
> >>
> >> HTH,
> >> Bernie
> >> MS Excel MVP
> >>
> >>
> >> "Uma Nandan" <(E-Mail Removed)> wrote in message
> >> news:E5AC0CF3-32C6-49F4-AC7E-(E-Mail Removed)...
> >> > Hi
> >> >
> >> > Would kindly request you to help for the following:
> >> >
> >> > 1) I need a VBA Code to detect the duplicates based on below data. Have
> >> > given my comments in Column D for for more information.
> >> > 2) After checking Column B with Column A & Column C the duplicates
> >> > should be
> >> > detleted & should pop a message box that these many duplicates deleted.
> >> > In
> >> > below mentioned Eg. the message box should display " Total Duplicated
> >> > Detected:2 , Unique Records:4"
> >> > __________________________________________________________
> >> >
> >> > EG:
> >> >
> >> > Column A ColumnB ColumnC Column
> >> > D
> >> > COMPANY NAME PROSPECT NAME TITLE COMMENTS
> >> > Wachovia David Wishon SVP Not a duplicate
> >> > Wachovia David Wishon Associate Not a
> >> > duplicate
> >> > Bank Of America Uma Nandan Researcher Not a duplicate
> >> > Citigroup Uma Nandan Researcher Not a
> >> > duplicate
> >> > Wachovia David Wishon Associate Duplicate.
> >> > Need to
> >> > delete
> >> > Bank Of America Uma Nandan Researcher Duplicate. Need to
> >> > delete
> >> >
> >> > _____________________________________________________________
> >> > Would appreciate if some one can help me with this. I have a data of
> >> > 50,000
> >> > to perform this task.
> >> >
> >> > Thanks in advance.
> >> >
> >> > Regards,
> >> > Uma
> >>
> >>
> >>
>
>
>