L
Lilivati
(Yes, I'm back again with another question, this group saves my life on
a daily basis... )
Anyway, I've never been a terribly efficient programmer, especially
with languages that are new to me (like VBA). Honestly I've never
really had to be; for most of the things I write memory resources are
more than adequate. However, most recently I've been working on a
"clean-up" macro for a long excel file spat out from a database. The
file is a massive parts list, and it has to be sorted and earlier
revisions of a part (essentially duplicates for the purposes of this
list) removed. The macro I wrote works well with shorter "test"
versions of the real list, and there's no reason why it shouldn't work
with the long list.
The issue is that the real list has ~56k rows. It takes 30 minutes for
just the first loop of the macro to execute. My machine is not the
best (256 MB RAM) but it is typical of the machines that will
ultimately use this macro. Running this macro also shoots my CPU usage
to 100% from about 1-3% when it is not running. What is baffling to me
is that this clean-up process is currently done by hand and it takes
fractions of a second to execute a command over the entire list that
way.
The whole idea behind adding this macro is to make the clean-up process
more efficient, and clearly that is not being accomplished if the macro
takes hours to finish.
The sub is called by pressing a button in another workbook (the
"cleaner" workbook that holds all my macros).
The first loop is necessary to sort the parts in correct numerical
order, but it really takes a long time. Is there any way to clean it
up? The sort and the second loop (which uses "i") are almost
instantaneous, then on the third loop (which uses "j") I get a "System
Error. The object invoked has disconnected from its clients." It is
definitely the third loop because if I comment it out I don't get this
error. As mentioned before this macro works in its entirety on a
smaller list.
The macro:
Sub Nassort()
Application.ScreenUpdating = False
'variable transfer from a userform to a worksheet (or from any A to B
in excel) is
'sketchy so I use a short hidden name function to move things around
instead
Dim nwb As String
nwb = GetHName("nassis")
'stupid formatting workaround, to make data numeric
With Workbooks(nwb).Worksheets(ws)
.Cells(2, 11).Copy
Dim k As Long
For k = 2 To .UsedRange.Rows.Count
.Cells(k, 3).PasteSpecial Paste:=xlAll, Operation:=xlAdd,
SkipBlanks:= _
False, Transpose:=False
Next k
End With
'sort the stuff by document and rev number
With Workbooks(nwb).Worksheets(ws)
.Range("A:F").sort _
Key1:=Workbooks(nwb).Worksheets(ws).Range("C2"), _
Order1:=xlAscending, _
Key2:=Workbooks(nwb).Worksheets(ws).Range("A2"), _
Order2:=xlAscending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
End With
'NOTE: If you don't do it this way (if you delete directly)
'Excel will miss lower rev numbers when more than two revs
'exist for a given part number
'clear the row if it is a lower rev level
Dim i As Long
Dim j As Long
With Workbooks(nwb).Worksheets(ws)
For i = 2 To .UsedRange.Rows.Count
If .Cells(i + 1, 3) = .Cells(i, 3) Then
If .Cells(i, 1) = "" Then
'do nothing, rev level is blank
ElseIf .Cells(i + 1, 1) > .Cells(i, 1) Then
.Cells(i, 7) = "delete"
'.UsedRange.Rows(i).EntireRow.Clear
End If
End If
Next i
'delete blank rows created above
For j = UsedRange.Rows.Count To 2 Step -1
If .Cells(j, 7) = "delete" Then
'.Cells(j, 5) = "delete"
.UsedRange.Rows(j).EntireRow.Delete
End If
Next j
End With
Application.ScreenUpdating = True
End Sub
Any ideas?
a daily basis... )
Anyway, I've never been a terribly efficient programmer, especially
with languages that are new to me (like VBA). Honestly I've never
really had to be; for most of the things I write memory resources are
more than adequate. However, most recently I've been working on a
"clean-up" macro for a long excel file spat out from a database. The
file is a massive parts list, and it has to be sorted and earlier
revisions of a part (essentially duplicates for the purposes of this
list) removed. The macro I wrote works well with shorter "test"
versions of the real list, and there's no reason why it shouldn't work
with the long list.
The issue is that the real list has ~56k rows. It takes 30 minutes for
just the first loop of the macro to execute. My machine is not the
best (256 MB RAM) but it is typical of the machines that will
ultimately use this macro. Running this macro also shoots my CPU usage
to 100% from about 1-3% when it is not running. What is baffling to me
is that this clean-up process is currently done by hand and it takes
fractions of a second to execute a command over the entire list that
way.
The whole idea behind adding this macro is to make the clean-up process
more efficient, and clearly that is not being accomplished if the macro
takes hours to finish.
The sub is called by pressing a button in another workbook (the
"cleaner" workbook that holds all my macros).
The first loop is necessary to sort the parts in correct numerical
order, but it really takes a long time. Is there any way to clean it
up? The sort and the second loop (which uses "i") are almost
instantaneous, then on the third loop (which uses "j") I get a "System
Error. The object invoked has disconnected from its clients." It is
definitely the third loop because if I comment it out I don't get this
error. As mentioned before this macro works in its entirety on a
smaller list.
The macro:
Sub Nassort()
Application.ScreenUpdating = False
'variable transfer from a userform to a worksheet (or from any A to B
in excel) is
'sketchy so I use a short hidden name function to move things around
instead
Dim nwb As String
nwb = GetHName("nassis")
'stupid formatting workaround, to make data numeric
With Workbooks(nwb).Worksheets(ws)
.Cells(2, 11).Copy
Dim k As Long
For k = 2 To .UsedRange.Rows.Count
.Cells(k, 3).PasteSpecial Paste:=xlAll, Operation:=xlAdd,
SkipBlanks:= _
False, Transpose:=False
Next k
End With
'sort the stuff by document and rev number
With Workbooks(nwb).Worksheets(ws)
.Range("A:F").sort _
Key1:=Workbooks(nwb).Worksheets(ws).Range("C2"), _
Order1:=xlAscending, _
Key2:=Workbooks(nwb).Worksheets(ws).Range("A2"), _
Order2:=xlAscending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
End With
'NOTE: If you don't do it this way (if you delete directly)
'Excel will miss lower rev numbers when more than two revs
'exist for a given part number
'clear the row if it is a lower rev level
Dim i As Long
Dim j As Long
With Workbooks(nwb).Worksheets(ws)
For i = 2 To .UsedRange.Rows.Count
If .Cells(i + 1, 3) = .Cells(i, 3) Then
If .Cells(i, 1) = "" Then
'do nothing, rev level is blank
ElseIf .Cells(i + 1, 1) > .Cells(i, 1) Then
.Cells(i, 7) = "delete"
'.UsedRange.Rows(i).EntireRow.Clear
End If
End If
Next i
'delete blank rows created above
For j = UsedRange.Rows.Count To 2 Step -1
If .Cells(j, 7) = "delete" Then
'.Cells(j, 5) = "delete"
.UsedRange.Rows(j).EntireRow.Delete
End If
Next j
End With
Application.ScreenUpdating = True
End Sub
Any ideas?