Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Check for duplicates? | Excel Worksheet Functions | |||
Summary sheet in effecient way | Excel Discussion (Misc queries) | |||
check for duplicates | Excel Worksheet Functions | |||
Check for Duplicates | Excel Worksheet Functions | |||
Check for Duplicates | Excel Worksheet Functions |