Posted to microsoft.public.excel.programming
|
|
Effecient way to check, add, delete duplicates
Sounds like a non-starter, but see the code suggested in response to a later
posting of yours.
--
Regards,
Tom Ogilvy
"vbastarter" wrote in message
...
Thanks Frank, I had a look at that site before. But I was not able to use
it
since
its based on One column and I have 2 columns to base my search. But
probabaly I could overcome that by concatenating my column values and use
the
script.
Still though I can delete m rows but I can't delete the n row in my
script
( I mean If I have 4 duplicates I can delete 3 and add to another sheet
but
there is no way to identify and remove the 4th row aswell. I have to
delete
all so that the user can later investigate those records before sending
the
list to clients.
What do you think about using arrays to replace my script ? I could
probabaly give it a go If I can figure out how to delete rows in array and
copy it back to sheet etc
TIA
VBAstarter
"Frank Kabel" wrote:
Hi
see:
http://www.cpearson.com/excel/NoDupEntry.htm
--
Regards
Frank Kabel
Frankfurt, Germany
vbastarter wrote:
Hi All, I'm new to vba and I have several scripts to write that are
based on similar work below. Once the user enters column name for
First and Last name, the scrips searches for duplicates based on the
2 fields, add the dupliactes to another sheet and deletes these
duplicate records from main sheet. Incase option "entiresearch" is
selected, script should search based on entire first name instead of
just the Firstname Initial. Though my below scripts works correctly,
It either doesn't or performs very slowly for huge data. Hence the
reason I had to set the limit below for 1026 (totrows)
I'm hoping anyone can suggest an alternative for the below - that
can
perform. I'm told about removing "cells" that will pick up little
speed. And the other is using arrays. Now I have figured out how to
declare and include arrays but I dont know how to do stuff like
copying to an array, deleting a row from an array or copying back it
to sheet.
Also an alternative way to write the code that is more effecient than
current is also welcome.
(Alan Beban, my email sanj2002 at hotmail for your suggestion)
Thanks in advance
Private Sub CmdSubNames_Click()
Dim r As Range, _
k As Range
Dim sh As Excel.Worksheet
Dim strFNameCol As String, _
strLNameCol As String
Dim intTotDB As Integer, _
totRows As Integer, _
intDupFound As Integer
strFNameCol = TxtFNCol.Value
strLNameCol = TxtLNCol.Value
Set r = ActiveWorkbook.ActiveSheet.Range("A:AS")
Set sh = ActiveWorkbook.Worksheets.Add
Set k = sh.Range("A:AS")
totRows = 1026
intTotDB = 1
n = 2
For n = 2 To totRows
If (r.Cells(n, strFNameCol)) < "" Or _
(r.Cells(n, strLNameCol)) < "" Then
For m = n + 1 To totRows
If OptEntireFNSearch Then
If Trim(UCase(r.Cells(n, strFNameCol))) =
Trim(UCase(r.Cells(m, strFNameCol))) And _
Trim(UCase(r.Cells(n, strLNameCol))) =
Trim(UCase(r.Cells(m, strLNameCol))) Then
intDupFound = 1
k.Rows(intTotDB).Value = r.Rows(m).Value
intTotDB = intTotDB + 1
r.Rows(m).Delete
m = m - 1
totRows = totRows - 1
End If
Else
If Trim(UCase(Left(r.Cells(n, strFNameCol), 1))) =
Trim(UCase(Left(r.Cells(m, strFNameCol), 1))) And _
Trim(UCase(r.Cells(n, strLNameCol))) =
Trim(UCase(r.Cells(m, strLNameCol))) Then
intDupFound = 1
k.Rows(intTotDB).Value = r.Rows(m).Value
intTotDB = intTotDB + 1
r.Rows(m).Delete
m = m - 1
totRows = totRows - 1
End If
End If
Next m
If intDupFound = 1 Then
k.Rows(intTotDB).Value = r.Rows(n).Value
intTotDB = intTotDB + 1
r.Rows(n).Delete
totRows = totRows - 1
n = n - 1
intDupFound = 0
End If
End If
Next n
End_of_Data:
MsgBox "Data Extracted"
End Sub
|