Deleting Duplicate with a Msg box which displays no of duplicates
 

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

Deleting Duplicate with a Msg box which displays no of duplicates
 

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:D" & 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:D" & myR).Sort Key1:=Range("D2"), _
Order1:=xlAscending, Header:= xlYes
Set myC = Columns("D: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" wrote in message
...
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

Deleting Duplicate with a Msg box which displays no of duplicates
 

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
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

Deleting Duplicate with a Msg box which displays no of duplica
 

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:D" & 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:D" & myR).Sort Key1:=Range("D2"), _
Order1:=xlAscending, Header:= xlYes
Set myC = Columns("D: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" wrote in message
...
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

Deleting Duplicate with a Msg box which displays no of duplica
 

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
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

Deleting Duplicate with a Msg box which displays no of duplica
 

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
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
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 -

Deleting Duplicate with a Msg box which displays no of duplica
 

After the line

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

put the line

On Error Resume Next


Bernie

"Uma Nandan" wrote in message
...
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:D" & 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:D" & myR).Sort Key1:=Range("D2"), _
Order1:=xlAscending, Header:= xlYes
Set myC = Columns("D: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" wrote in message
...
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

Deleting Duplicate with a Msg box which displays no of duplica
 

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:D").Find(What:="2")

put the line

On Error Resume Next


Bernie

"Uma Nandan" wrote in message
...
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:D" & 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:D" & myR).Sort Key1:=Range("D2"), _
Order1:=xlAscending, Header:= xlYes
Set myC = Columns("D: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" wrote in message
...
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