View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
vbastarter vbastarter is offline
external usenet poster
 
Posts: 14
Default excel vba loop performance

Now I'm trying to compare Nmaes in a sheet for duplicates and delete and put
them in a new sheet. I'm new to vba and find that the lopps are taking way
too long. For that matter programs gets stuck for more than 1000 rows. So I
had to put a limit on 1000 here But that can't be much helpful since all the
data are usually above around 5000 or more.
Is there any function that can replace my loops and make things faster. That
my code below. Quick Help Appreciated

For n = 2 To 1000
If (r.Cells(n, strFNameCol)) < "" Or _
(r.Cells(n, strLNameCol)) < "" Then

For m = n + 1 To 1000
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 ' Not null If
Next n



End_of_Data:
MsgBox "Data Extracted"

End Sub