Macro is slow, is there a way to speed it up?

[RSLQA]

Hello,

My macro works but can take up to 5 minutes or more to finish up. Is there a better way to do what I have below? The table creation goes quickly it is when it goes through it to delete what it doesn't need that slows it down. I am using excel 2013, and most of my experience with vba comes from watching the recorder so I'm wandering into unfamiliar territory.

Thank you

Sub Psudo()

' First Creates a table

Dim Tbl As ListObject
Set Tbl = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes)
Tbl.TableStyle = "TableStyleMedium2"

' Selects and renames the Table to DashTable

Columns("A:I").Select
ActiveSheet.ListObjects(1).Name = "PsudoTbl"

' Clears out the old fill in the cells so the table style shows through

Range("PsudoTbl[#All]").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With

' FormatText Macro
Range("PsudoTbl[CASE_SSN]").Select
Selection.NumberFormat = "@"

' Delete rows if not a "P"
Dim LastRow As Integer
Dim n As Long
Dim DestinationRow As Integer
Dim CellValue As String

LastRow = Worksheets("Psudo").Range("A65536").End(xlUp).Row

For n = LastRow To 2 Step -1

CellValue = Worksheets("Psudo").Range("A" & n)

If Left(CellValue, 1) <> "P" Then
Worksheets("Psudo").Range("A" & n & ":Y" & n).EntireRow.Delete xlUp
ElseIf Left(CellValue, 1) = "P" Then
CellValue = Right(CellValue, 4)
Worksheets("Psudo").Range("A" & n) = CellValue
End If

Next n
End Sub

 

[vamsidhar]

Though i haven't Scanned the code you pasted I think You can use

" Application.DisplayAlerts = False " as first line in your macro.

Though it executes code it won't update view during execution and may save considerable amount of time.


You can have a try

 

[Comfy]

Deleting rows in a ListObject 1 by 1 is time consuming.

My advice would be to:

* Convert all cells in A to Values
* Sort by Column A
* Find the row number of the first occurance of "P"
* Delete all rows prior to this
* Find the row number of the last occurance of "P"
* Delete all rows after this
* Convert all remaining values to the last 4 characters

 

[healey21]

Try to switch off application commands to see if it runs your code quicker

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

'Your code goes here

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic

 

[RSLQA]

Thank you all very much! I used vamsidhar and healey21's advice and it dropped the time from about 5 minutes to less than 30 seconds. I will try to rewrite it using Comfy's suggestion later. I appreciate all the help, thank you again.