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

excel vba loop performance
 

I didn't take the time to try to understand your code,
but if you transfer the range to a vba array, do your looping and
modifications to the array, then retransfer the resulting array back to
the worksheet, the speed of execution should be vastly improved; like by
a factor of hundreds.

You will need to figure out how to accomplish the array analog of, e.g.,
r.rows(m).Delete. You can either work through how to delete a row of a
VBA array, or have the code keep track of the rows to be deleted and
delete them after having transferred the data back to the worksheet. As
I mentioned, I didn't learn enough about what the code was doing to work
out exactly how to accomplish it.

Alan Beban

vbastarter wrote:

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