LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 14
Default Effecient way to check, add, delete duplicates

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



 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

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
Check for duplicates? Vass[_2_] Excel Worksheet Functions 5 October 24th 07 11:12 PM
Summary sheet in effecient way sumit Excel Discussion (Misc queries) 0 December 11th 06 10:00 AM
check for duplicates Todd Excel Worksheet Functions 0 November 7th 06 05:59 PM
Check for Duplicates Carter68 Excel Worksheet Functions 3 April 15th 06 12:13 AM
Check for Duplicates nebb Excel Worksheet Functions 2 February 13th 06 02:39 PM


All times are GMT +1. The time now is 05:50 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"