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