View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
cardan cardan is offline
external usenet poster
 
Posts: 112
Default Macro to Convert Value to Number, Sort, then Delete

On Mar 7, 1:12*pm, Wouter HM wrote:
Hello Dan,

In Excel 2010 I recorded the macro and added the timeGetTime function
to see how much time is needed.
I filled a single sheet with 80 colums and 8000 rows of random
figures.
Next I copied the valuesand used a formula in column A to determe is a
row should be deleted.

I have a Intel Core i3 cpu (quad core) running at 2.13 GHz and 3.0 GB
Ram.

For the single sheet I tested it on my computer needed 5553
milliseconds.
If I add a loop to select the 10 sheets you mentioned I estimate a
runtime of about 1 minute.

Option Explicit

Declare Function timeGetTime Lib "winmm.dll" () As Long

Sub cardan()
'
' cardan Macro
'
* * Dim lngStart As Long
* * Dim lngEnd As Long

* * lngStart = timeGetTime
'
* * Range("A1").Select
* * Range(Selection, Selection.End(xlToRight)).Select
* * Selection.AutoFilter
* * Range("A1").Select
* * ActiveSheet.Range("$A$1:$CC$8001").AutoFilter Field:=1,
Criteria1:="Delete"
* * Rows("13:13").Select
* * Range(Selection, Selection.End(xlDown)).Select
* * Selection.Delete Shift:=xlUp
* * Selection.AutoFilter
* * Range("A1").Select

* * lngEnd = timeGetTime

* * MsgBox lngEnd - lngStart & " milliseconds"

End Sub

HTH,

Wouter


Hi Wouter, thank you for the reply. I should have mentioned that I am
using Excel 2007. Not sure if that matters. I think my processing
speed is similar to yours. For some reason the macro I have takes
over a minute per page to delete the rows marked as "DELETE". When I
sort the data first and then run the macro it only takes a few
seconds. I figured if there was a way to sort the data first and then
run the macro, It would be ideal.

Below is the macro I am using. Does it look appropriate? I must
admit, my macro skills can also be classified as below average and I
am not the author of it. What would be the best way to approach this
issue? Thank you again.

Sub deleterows7()
'
' deleterows7 Macro
'
' Keyboard Shortcut: Ctrl+Shift+P
'
Dim WS As Worksheet
Dim DeleteThese As Range
Dim LastRow As Long
Dim R As Long

For Each WS In _
Application.ActiveWindow.SelectedSheets
Set DeleteThese = Nothing
With WS
LastRow = .Cells(.Rows.Count, 1) _
.End(xlUp).Row
For R = LastRow To 1 Step -1
If .Cells(R, 1).Value = "DELETE" Then
If DeleteThese Is Nothing Then
Set DeleteThese = .Rows(R)
Else
Set DeleteThese = _
Application.Union(DeleteThese, .Rows(R))
End If
End If
Next R
If Not DeleteThese Is Nothing Then
DeleteThese.Delete
End If
End With
Next WS
End Sub