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

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

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

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