Please assit to Optimize the performance

Hi Team,
Can one of you please assist me in optimizing the below MACRO performance. I was able to execute the MACRO and I see output as desired on most of the time however my major challenge is as it is taking a good amount of time to run irrespective of the input data.

<
Sub Master_Macro()
' test1 Macro
Dim RowtoTest As Long
Dim workrange As Range
Dim cell As Range
Dim lLastRow As Long

Worksheets("Pay Rate RPT").Activate
With Sheets("Pay Rate RPT")

Range("A1").Select
ActiveCell.EntireRow.Delete
ActiveCell.EntireRow.Delete
ActiveCell.EntireRow.Delete
ActiveCell.EntireRow.Delete
Range("A2").Select
ActiveCell.EntireRow.Delete
'ActiveCell.EntireRow.Delete
'ActiveCell.EntireRow.Insert
Range("B1").Select
ActiveCell.FormulaR1C1 = "Check"
lLastRow = Cells(Rows.Count, "A").End(xlUp).Row
With Range("B2:B" & lLastRow)
.FormulaR1C1 = "=LEN(RC[-1])"
.Value = .Value
End With

For RowtoTest = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
With Cells(RowtoTest, 2)
If .Value <> "152" _
Then _
Rows(RowtoTest).EntireRow.Delete
End With
Next RowtoTest

Range("B1").Select
ActiveCell.EntireColumn.Delete
Range("A1").Select

'Range("B:B").Select
'Set workrange = Intersect(Selection, ActiveSheet.UsedRange)
'For Each cell In workrange
'If ActiveCell.Value <> "152" _
'Then ActiveCell.EntireRow.Delete
'Next cell

Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(11, 1), Array(21, 2), Array(30, 1), Array(45, 1), _
Array(55, 1), Array(67, 1), Array(87, 1), Array(100, 1), Array(114, 1), Array(126, 1), _
Array(142, 1)), TrailingMinusNumbers:=True
Range("A1").Select

Columns("F:F").Select
Selection.Cut
Columns("P:P").Select
Selection.Insert Shift:=xlToRight
Range("B1").Select

lLastRow = Cells(Rows.Count, "A").End(xlUp).Row
With Range("L2:L" & lLastRow)
.FormulaR1C1 = "=RC[-11]&CHAR(45)&RC[-10]&CHAR(45)&RC[-9]&CHAR(45)&TEXT(RC[-8],""MMDDYY"")&CHAR(45)&TEXT(RC[-7],""MMDDYY"")&CHAR(45)&LEFT(RC[-1],3)"
'.Value = .Value
End With
With Range("M2:M" & lLastRow)
.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC[-1],'Prelim RPT'!C19,1,0)),""Not Found"",""Found"")"
'.Value = .Value
End With
End With
'Naresh
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection.Interior
Selection.Font.Bold = True
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16764057
.TintAndShade = 0
.PatternTintAndShade = 0
End With

With Selection.Font
.Name = "Frutiger 45 Light"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Cells.Select
With Selection.Font
.Name = "Frutiger 45 Light"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With

Range("A:O").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A1").Select

Worksheets("Prelim RPT").Activate
With Sheets("Prelim RPT")

lLastRow = Cells(Rows.Count, "A").End(xlUp).Row

Range("A1").Select
ActiveCell.EntireRow.Delete
ActiveCell.EntireRow.Delete
Range("A2").Select
ActiveCell.EntireRow.Delete
ActiveCell.EntireRow.Delete

Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(8, 1), Array(27, 2), Array(36, 1), Array(48, 1), _
Array(60, 1), Array(79, 1), Array(92, 1), Array(108, 1), Array(126, 1), Array(138, 1), _
Array(144, 1), Array(163, 1), Array(174, 1), Array(190, 1), Array(204, 1), Array(221, 1), _
Array(239, 1)), TrailingMinusNumbers:=True
Range("A1").Select

lLastRow = Cells(Rows.Count, "A").End(xlUp).Row
With Range("S2:S" & lLastRow)
.FormulaR1C1 = "=IF(RC[-2]="""",RC[-18]&CHAR(45)&RC[-17]&CHAR(45)&RC[-16]&CHAR(45)&TEXT(RC[-15],""MMDDYY"")&CHAR(45)&TEXT(RC[-14],""MMDDYY"")&CHAR(45)&LEFT(RC[-8],3),"""")"
'.Value = .Value
End With
With Range("T2:T" & lLastRow)
'.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC[-1],'Pay Rate RPT'!C12,1,0)),""Not Found"",""Found"")"
.FormulaR1C1 = "=IF(RC[-9]<>""TOT"",IF(ISERROR(VLOOKUP(RC[-1],'Pay Rate RPT'!C12,1,0)),""Not Found"",""Found""),"""")"
'.FormulaR1C1 = "=IF(RC[-9]=.""DIV1"",IF(ISERROR(VLOOKUP(RC[-1],'Pay Rate RPT'!C12,1,0)),""Not Found"",""Found""),"""")"
'.Value = .Value
End With

End With

Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection.Interior
Selection.Font.Bold = True
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16764057
.TintAndShade = 0
.PatternTintAndShade = 0
End With

With Selection.Font
.Name = "Frutiger 45 Light"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With

With Selection.Font
.Name = "Frutiger 45 Light"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("A:U").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A1").Select

Worksheets("DORS").Activate
With Sheets("DORS")

lLastRow = Cells(Rows.Count, "A").End(xlUp).Row
With Range("P3:P" & lLastRow)
.FormulaR1C1 = "=LEFT(RC[-7],FIND(CHAR(10),RC[-7]))"
.Value = .Value
End With

With Range("Q3:Q" & lLastRow)
.FormulaR1C1 = "=(RC[-9])"
.Value = .Value
End With

Columns("Q:Q").Select
Selection.TextToColumns Destination:=Range("Q1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

Columns("P:S").Select
Selection.Copy

Worksheets("Notes").Activate
With Sheets("Notes")

Sheets("Notes").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2, 3)
ActiveSheet.Outline.ShowLevels RowLevels:=2

Columns("A:D").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Range("A1").Select
ActiveSheet.Outline.ShowLevels RowLevels:=2
Range("A:D").Select

Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1, 2), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2

With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Columns.AutoFit
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy

Worksheets("DORS").Activate
With Sheets("DORS")

Sheets("DORS").Select
Range("O2").Select
ActiveSheet.Paste

Range("P3").Select
ActiveCell.FormulaR1C1 = "Sum of EXE QTY"
With Range("P3:P" & lLastRow)
.FormulaR1C1 = "=LEFT(RC[-1],SEARCH("" "",RC[-1])-1)"
.Value = .Value
End With
Range("P2").Select
ActiveCell.FormulaR1C1 = "Symbols"
Range("O1").Select
ActiveCell.EntireColumn.Delete

lLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A:L").Select
Cells.Select
Selection.Columns.AutoFit

With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("A1:L1").Select
End With

Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection.Interior
Selection.Font.Bold = True
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16764057
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Worksheets("Cash Exception and Full Match").Activate
With Sheets("Cash Exception and Full Match")

lLastRow = Cells(Rows.Count, "A").End(xlUp).Row

Range("T3").Select
ActiveCell.FormulaR1C1 = "Vlook up"
With Range("T4:T" & lLastRow)
.FormulaR1C1 = "=IF(RC[-13]=""US"",VLOOKUP(RC[-18],'Prelim RPT'!C[-19],1,0),IF(RC[-13]="""","""",IF(RC[-13]=""COUNTRY"",""VLOOKUP"",""Foreign"")))"
.Value = .Value
End With

With Range("U4:u" & lLastRow)
.FormulaR1C1 = "=IF(RC[-14]=""COUNTRY"",""Comment"","""")"
.Value = .Value

End With
End With

Worksheets("KIP Open and Pending Items").Activate
With Sheets("KIP Open and Pending Items")

' Range("A1").Select
' ActiveCell.EntireRow.Insert

Range("E1").Select
ActiveCell.EntireColumn.Delete
Range("A1").Select
lLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("H1").Select
ActiveCell.FormulaR1C1 = "VLOOKUP"

With Range("H2:H" & lLastRow)
.FormulaR1C1 = "=VLOOKUP(C1,'Prelim RPT'!C[-7],1,0)"
.Value = .Value
Range("H3").Select
End With
With Range("I2:I" & lLastRow)
.FormulaR1C1 = "=IF(RC[-3]=""UNITED STATES"","" "",IF(RC[-3]=""Puerto Rico"",""UIT"",IF(RC[-3]="""","""",""Foreign Security"")))"
.Value = .Value
Range("A1").Select
End With
End With

Range("A1").Select
Sheets("DashBoard").Select
Range("A1").Select

MsgBox "Macro Completed - Naresh Maram"
End With
End With
End Sub
>

Hi Team,
Can one of you please assist me in optimizing the below MACRO performance. I was able to execute the MACRO and I see output as desired on most of the time however my major challenge is as it is taking a good amount of time to run irrespective of the input data.

Please Login or Register  to view this content.

Thanks for your Kevinu, In above .Delete, I was actually deleting the whole row itself and nit just the data. Am sure each of the steps in my code would have a much better steps which am not aware of....
Thanks for your tip though, will certainly keep in mind...
Let me wait for a further more intense sokution to see rwmarkable change in time taken to execute than now...Thanks you once again.

Thanks for your time Scottiex, will certainly apply your suggestions and will try see where exactly is it taking time and will seek your assistance.
It's really pleasure to have someone like you who always ready to help.
Thanks for your time.

Hi Scottiex,
I tried to esc while macro was running and most of the time I see code stopped in below - I suppose this is what taking major run time.
Is there any way to run the below code quickly PLEASE

Please Login or Register  to view this content.

Hi Scottiex,
Seems your second tip also did worked,
Can you please have a quick look at below and
help me with any better alternate please
I have similar vlookups too that I might amend, might see further change in run time

Please Login or Register  to view this content.