Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Deleting Duplicate with a Msg box which displays no of duplicates
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27
Default 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
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5,441
Default 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


Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 703
Default 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

Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27
Default 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



Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27
Default 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


Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 703
Default 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 -

Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5,441
Default 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





Reply With QuoteReply With Quote
  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27
Default 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






Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Merging duplicate entries in Excel or deleting the duplicates (Exc guinessgirl90 Excel Worksheet Functions 1 April 2nd 09 01:06 PM
deleting duplicates Nolaughmtr Excel Programming 2 September 12th 07 07:20 PM
ComboBox displays duplicates - please help Jeff Excel Programming 2 November 14th 06 10:10 PM
Deleting duplicates Judd Jones[_2_] Excel Programming 2 January 17th 05 03:30 PM
Deleting Duplicates halem2[_45_] Excel Programming 1 October 19th 04 09:11 PM


All times are GMT +1. The time now is 03:57 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement