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