Arrays to replace very slow loops ?
An array assiged as you have will be a 2 dimensional array.
Since you are picking up values. the array elements will not have properties
like row and so forth.
Since you delete a row when you find a match, you can then throw out your
array since it will no longer match your worksheet.
--
Regards,
Tom Ogilvy
"vbastarter" wrote in message
...
Hi I had a post here asking if my loops that run very slowly can be made
any
quick.
One suggestion was to replace with an Array.
Now I'm new to VBA and have no idea how to go about Arrays. Below is my
code
where I'm finding dulicates based on name fields deleting from that and
adding to another sheet. Here I have 2 text boxes to enter position of
Names
Fields and and an option to choose entire FName to be searched instead of
just FName initial.
Now all that I did is replace my r and k range with arrays but I get and
error at this line : If Trim(UCase(Array1(i).Cells(n, strFNameCol))) =
Trim(UCase(Array1(i).Cells(m, strFNameCol))) And _
Trim(UCase(Array1(i).Cells(n, strLNameCol))) =
Trim(UCase(Array1(i).Cells(m,
strLNameCol))) . It says runtime error "Runtime error 9 Subscript out of
Range"
My code as below:
Private Sub CmdSubmitNames_Click()
Dim r As Range, _
k As Range
Dim sh As Excel.Worksheet
Dim strFNameCol As String, _
strLNameCol As String
Dim intCounter As Integer, _
intTotDB As Integer, _
totRows As Integer, _
intDupFound As Integer, _
intTotDB2 As Integer, _
i As Integer, _
intTotfile As Integer
Dim Array1(), _
Array2()
totRows = 1026
intCounter = 0
strFNameCol = TxtFNCol.Value
strLNameCol = TxtLNCol.Value
Set r = ActiveWorkbook.ActiveSheet.Range("A:AS")
Set sh = ActiveWorkbook.Worksheets.Add
Set k = sh.Range("A:AS")
Array1 = r.Value
Array2 = k.Value
intTotDB = 1
n = 2
For n = 2 To 1000
If (Array1(i).Cells(n, strFNameCol)) < "" Or _
(Array1(i).Cells(n, strLNameCol)) < "" Then
For m = n + 1 To 1000
If OptEntireFNSearch Then
If Trim(UCase(Array1(i).Cells(n, strFNameCol))) =
Trim(UCase(Array1( i).Cells(m, strFNameCol))) And _
Trim(UCase(Array1(i).Cells(n, strLNameCol))) =
Trim(UCase(Array1(i).Cells(m, strLNameCol))) Then
intDupFound = 1
Array2(i).Rows(intTotDB).Value = Array1(i).Rows(m).Value
intTotDB = intTotDB + 1
Array1(i).Rows(m).Delete
m = m - 1
totRows = totRows - 1
End If
Else
If Trim(UCase(Left(Array1(i).Cells(n, strFNameCol), 1))) =
Trim(UCase(Left(Array1(i).Cells(m, strFNameCol), 1))) And _
Trim(UCase(Array1(i).Cells(n, strLNameCol))) =
Trim(UCase(Array1(i).Cells(m, strLNameCol))) Then
intDupFound = 1
Array2(i).Rows(intTotDB).Value = Array1(i).Rows(m).Value
intTotDB = intTotDB + 1
Array1(i).Rows(m).Delete
m = m - 1
totRows = totRows - 1
End If
End If
Next m
If intDupFound = 1 Then
Array2(i).Rows(intTotDB).Value = Array1(i).Rows(n).Value
intTotDB = intTotDB + 1
Array1(i).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
Thanks In Advance
|