Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Excel sluggish performance | Excel Discussion (Misc queries) | |||
excel sub-par performance | Excel Discussion (Misc queries) | |||
Excel Speed Performance help | Excel Discussion (Misc queries) | |||
Excel 2002 performance | Excel Discussion (Misc queries) | |||
can i set up "up and down" performance arrows from excel? | Setting up and Configuration of Excel |