Macro to Convert Value to Number, Sort, then Delete

[cardan]

Hello,
I have a spreadsheet with copious amounts of data (10 sheets with ~80
columns x 8000 rows). The file size is so large that I need to break
the data into groups and then delete the rows that do not pertain.

I have identified the rows I would like to delete by writing a formula
in Column A. This formula returns the word "DELETE" for the rows I
want to delete.

The best macro would be one that will convert these formulas to its
value and then sorts the data by Column A to get the all the "DELETE"s
into one grouping. I would then need this macro to delete all the
Rows that have the word "DELETE" in column A.

I have a macro that will delete all the rows that have the word
"DELETE" in column A, however it takes forever to run. I can actually
sort and delete quicker manually, however this is an ongoing project
and gets repetitious quickly.

Any help would be greatly appreciated! Thank you for your time.

 

[Harald Staff]

Hi

Row deletion with VBA got painfully slow in version 2007 for some strange
reason. I'd do it this way:

1 Insert two new columns (here A and B)
2 Number all rows top to bottom in column A
3 Mark deletion rows in column B
4 Sort by B column. Delete the marked rows
5 Sort by A column to restore original order
6 Delete columns A and B

Best wishes Harald

 

[Wouter HM]

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

 

[cardan]

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

 

[cardan]

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

Hi Again Wouter
I apologize for my previous response, I thought the macro to review
the timing to run the macro. I inserted the macro and it works -
unbelievably faster than the one I was using! I am however, have some
issues with it. When I run it, it does the sorting and deletion in a
couple seconds and then gives me the message box of 0 milliseconds,
however it is still running and won't stop until I hit OK.

My data range starts in Cell B6. Rows 1-5 are headers. Does this
have anything to do with it? Any further assistance would be great!
thank you again!

Dan

 

[Clif McIrvin]

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.

------------

This post by Martin Brown in another thread might shed some light on
your performance issues:

http://groups.google.com/group/microsoft.public.excel.programming/msg/bc5a67ba46933bed

 

[Rick Rothstein]

I have a spreadsheet with copious amounts of data (10 sheets

with ~80 columns x 8000 rows). The file size is so large that
I need to break the data into groups and then delete the rows
that do not pertain.

I have identified the rows I would like to delete by writing a
formula in Column A. This formula returns the word "DELETE"
for the rows I want to delete.

Since you already have formulas in place in Column A displaying either the
word DELETE or the empty string, then give this macro a try...

Sub DeleteDELETEs()
Dim UnusedCol As Long, LastRow As Long, Cell As Range, WS As Worksheet
Const WSnames As String = "Sheet1,Sheet2,Sheet3,Sheet4,Sheet5"
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next
For Each WS In Worksheets(Split(WSnames, ","))
UnusedCol = WS.Cells.Find(What:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column + 1
LastRow = WS.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
With WS.Range(WS.Cells(1, UnusedCol), WS.Cells(LastRow, UnusedCol))
.Value = WS.Range(WS.Cells(1, "A"), WS.Cells(LastRow, "A")).Value
.SpecialCells(xlCellTypeConstants).EntireRow.Delete
End With
Next
On Error GoTo 0
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

The only thing you need to do is change the cells being assigned to the
WSnames constant (the Const statement) to the names of the sheets you want
to run the code against. NOTE... do NOT put any spaces around the commas in
the list you create for this assignment.

Rick Rothstein (MVP - Excel)

 

[cardan]

Since you already have formulas in place in Column A displaying either the
word DELETE or the empty string, then give this macro a try...

Sub DeleteDELETEs()
  Dim UnusedCol As Long, LastRow As Long, Cell As Range, WS As Worksheet
  Const WSnames As String = "Sheet1,Sheet2,Sheet3,Sheet4,Sheet5"
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  On Error Resume Next
  For Each WS In Worksheets(Split(WSnames, ","))
    UnusedCol = WS.Cells.Find(What:="*", SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column + 1
    LastRow = WS.Cells.Find(What:="*", SearchOrder:=xlRows, _
              SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
    With WS.Range(WS.Cells(1, UnusedCol), WS.Cells(LastRow, UnusedCol))
      .Value = WS.Range(WS.Cells(1, "A"), WS.Cells(LastRow, "A"))..Value
      .SpecialCells(xlCellTypeConstants).EntireRow.Delete
    End With
  Next
  On Error GoTo 0
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

The only thing you need to do is change the cells being assigned to the
WSnames constant (the Const statement) to the names of the sheets you want
to run the code against. NOTE... do NOT put any spaces around the commas in
the list you create for this assignment.

Rick Rothstein (MVP - Excel)

Hi Rick,
Thank you for the response. I am having some issues with the macro. I
changed the sheet names to the names of the sheets in my workbook it
does not seem to work. Could it be my formula in column A? Here is
the formula I am using. =IFERROR(IF(VLOOKUP($B11,'MainList'!$C$28:$K
$8242,9,FALSE)<>$A$4,"DELETE",$A$4),"DELETE"). Cell A4 represents the
"region" I want to keep. If cell A4's value is SW, the formula will
return either "SW" or "DELETE". My data also starts in row 6 (rows
1-4 are headers) Does this make a difference? Thank you again.

 

[Rick Rothstein]

Thank you for the response. I am having some issues with

the macro. I changed the sheet names to the names of the
sheets in my workbook it does not seem to work. Could it
be my formula in column A? Here is the formula I am using.
=IFERROR(IF(VLOOKUP($B11,'MainList'!$C$28:$K$8242,9,
FALSE)<>$A$4,"DELETE",$A$4),"DELETE").
Cell A4 represents the "region" I want to keep. If cell A4's
value is SW, the formula will return either "SW" or "DELETE".
My data also starts in row 6 (rows 1-4 are headers) Does this
make a difference? Thank you again.

Yes, your formula is causing my code the problem. The way you first
described what your formula did, I got the impression it displayed either
the word DELETE or nothing at all, so I designed the code for that
interpretation... actually, something is displayed in every cell by your
formula. Given your fuller description, here is a different macro for you to
try...

Sub DeleteDELETEs()
Dim UnusedCol As Long, LastRow As Long, Cell As Range, WS As Worksheet
Const WSnames As String = "Sheet1,Sheet2,Sheet3,Sheet4,Sheet5"
Const StartRow As Long = 6
Const FormulaCol As String = "J"
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next
For Each WS In Worksheets(Split(WSnames, ","))
UnusedCol = WS.Cells.Find(What:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column + 1
LastRow = WS.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
With WS.Range(WS.Cells(StartRow, UnusedCol), WS.Cells(LastRow,
UnusedCol))
.Value = WS.Range(WS.Cells(StartRow, FormulaCol), WS.Cells(LastRow,
FormulaCol)).Value
.Replace "DELETE", "", xlWhole, , False
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Columns(UnusedCol).Clear
Next
On Error GoTo 0
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Rick Rothstein (MVP - Excel)

 

[Wouter HM]

hi Dan,

I changed my test werkbook to 10 sheets and added a loop to my code
I used a bit from Rick sample for the loop.

Sub cardan()
'
' cardan Macro
'
Const WSnames As String = _
"Sheet1,Sheet2,Sheet3,Sheet4,Sheet5," & _
"Sheet6,Sheet7,Sheet8,Sheet9,Sheet10"

Dim lngStart As Long
Dim lngEnd As Long
Dim WS As Worksheet

lngStart = timeGetTime
'
For Each WS In Worksheets(Split(WSnames, ","))
WS.Activate
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("A5").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.AutoFilter
Range("A6").Select
ActiveSheet.Range("$A$1:$CC$8001").AutoFilter _
Field:=1, Criteria1:="Delete"
While ActiveCell.Text <> "Delete"
ActiveCell.Offset(1, 0).Select
Wend
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Range("A5").Select
Next

lngEnd = timeGetTime

MsgBox lngEnd - lngStart & " milliseconds"


End Sub

At my computer it needed 3 minutes and 16 seconds to complete.
I placed the ScreenUpdating inside the loop so you can see the
selection of each sheet.

HTH,


Wouter

 

[Rick Rothstein]

At my computer it needed 3 minutes and 16 seconds

to complete. I placed the ScreenUpdating inside the
loop so you can see the selection of each sheet.

I believe if you move the ScreenUpdating and the Calculation statements
outside the loop (as I did in my code), your macro would execute quicker.
Also, since you seem to have a workbook set up with example data, after you
move those statements outside the loop and get a new execution time for your
code, would you do me a favor and set the data back up and use my code to
processes it... I would be curious as to the time difference between your
approach and mine (where both are run on the same computer). Thanks.

Rick Rothstein (MVP - Excel)

 

[Wouter HM]

Hi Rick,

Today I have these results:
Your code: 203762 milliseconds
My code: 200895 milliseconds

I only tried both versions once.

Today I had MS-Word and Google-Earth active.
These seems to take some CPU time.

Wouter

 

[Rick Rothstein]

Today I have these results:

Your code: 203762 milliseconds
My code: 200895 milliseconds

I only tried both versions once.

Thanks for running the test, I appreciate it. Seems like the two methods are
reasonably equivalent, speed-wise, differing by about 3 seconds out of about
200 total seconds.

Rick Rothstein (MVP - Excel)

 

[cardan]

Thanks for running the test, I appreciate it. Seems like the two methods are
reasonably equivalent, speed-wise, differing by about 3 seconds out of about
200 total seconds.

Rick Rothstein (MVP - Excel)

I can't seem to get the macro to work. I am using the combined macro
provided by Wouter. It appears the error is in the "ActiveCell.Offset
(1,0).Select" line. At least that is what is highlighted when I do
debug. Any thoughts on what I could be missing or doing wrong?

 

[Rick Rothstein]

I can't seem to get the macro to work. I am using the

combined macro provided by Wouter. It appears the
error is in the "ActiveCell.Offset(1,0).Select" line. At
least that is what is highlighted when I do debug. Any
thoughts on what I could be missing or doing wrong?

Since you are using Wouter's code, I would think you should be directing
your question to him, not me, given that he would be more familiar with the
ins-and-outs of the code he wrote. However, in looking quickly at the code
he posted, the problem may lie with the line above the one you identified,
namely, this one...

While ActiveCell.Text <> "Delete"

I would note that your original post said you had "DELETE" (all upper case)
in your cells whereas Wouter's code is testing against "Delete" (mixed
case). Try changing this line of code to the following and see if that makes
your code work...

While ActiveCell.Text <> "DELETE"

Rick Rothstein (MVP - Excel)

 

[Wouter HM]

Hi Dan,

To make it even beter try this:

While UCase(ActiveCell.Text) <> "DELETE"

If you change the formula in the A column to lower or mixes case the
macro will still work.

Wouter

 

[cardan]

Since you are using Wouter's code, I would think you should be directing
your question to him, not me, given that he would be more familiar with the
ins-and-outs of the code he wrote. However, in looking quickly at the code
he posted, the problem may lie with the line above the one you identified,
namely, this one...

While ActiveCell.Text <> "Delete"

I would note that your original post said you had "DELETE" (all upper case)
in your cells whereas Wouter's code is testing against "Delete" (mixed
case). Try changing this line of code to the following and see if that makes
your code work...

While ActiveCell.Text <> "DELETE"

Rick Rothstein (MVP - Excel)

I changed the word Delete to all caps and it seemed to work. However,
when it completes, the message box says "0 milliseconds" and it still
appears to run until I hit OK. Is this what it is supposed to do?
Overall it took about 5 minutes to delete the rows on 8 tabs.

On a side note, what is interesting is that the time it takes do
delete the rows is inverse to the amount of "DELETE" rows I have. For
instance, the spreadsheet I scale down with the most "DELETE"S, has
about 7,750 "DELETE"'s. (I am only keeping 250 rows). It takes about
25 seconds to cycle through. The spreadsheet with the least amount of
deletes (4,500 rows to Delete), it takes about 5 minutes. It just
seems like the more rows it has to delete, the longer it should take.
Just an observation.

Thank you again for your help!

 

[Wouter HM]

Hi Dan,

This is my final version:

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


Sub cardan()
'
' cardan Macro
'
Const WSnames As String = _
"Sheet1,Sheet2,Sheet3,Sheet4,Sheet5," & _
"Sheet6,Sheet7,Sheet8,Sheet9,Sheet10"

Dim lngStart As Long
Dim lngEnd As Long
Dim WS As Worksheet

lngStart = timeGetTime
'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each WS In Worksheets(Split(WSnames, ","))
WS.Activate
Range("A5").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.AutoFilter
Range("A6").Select
ActiveSheet.Range("$A$1:$CC$8001").AutoFilter _
Field:=1, Criteria1:="Delete"
While UCase(ActiveCell.Text) <> "DELETE"
ActiveCell.Offset(1, 0).Select
Wend
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter
Range("A5").Select
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

lngEnd = timeGetTime

MsgBox lngEnd - lngStart & " milliseconds"


End Sub


The message box should appear after all tabs are processed.


HTH,

Wouter