Optimize Code

Hi,

Thanks in advance to you experts for your help. Is is possible for the following code to be improved in speed as it takes 90 seconds with 150,00 rows?

Sub CopyInfoToAdjacentCells()
    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    With ActiveSheet
        .Select
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView
        .DisplayPageBreaks = False
        Firstrow = 2
        Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For Lrow = Lastrow To Firstrow Step -1
            With .Cells(Lrow, "A")
                If Not IsError(.Value) Then
                    If Left(.Cells, 7) Like "TOTAL $*" Then
                        If .Offset(-1, 0).Value Like "FIXED *" Then
                            .Offset(0, 7).FormulaR1C1 = "=TRIM(MID(SUBSTITUTE(RC[-7],"" "",REPT("" "",99)),100,99))"
                        End If
                    End If
                End If
            End With
            With .Cells(Lrow, "A")
                If Not IsError(.Value) Then
                    If Left(.Cells, 5) Like "TITLE*" Then
                        .Offset(0, 8).FormulaR1C1 = "=MID(RC[-8],SEARCH(""TITLE"",RC[-8])+5,SEARCH(""PROJECT"",RC[-8])-SEARCH(""TITLE"",RC[-8])-6)"
                    End If
                End If
            End With
            With .Cells(Lrow, "A")
                If Not IsError(.Value) Then
                    If Left(.Cells, 5) Like "TITLE*" Then
                        If Not .Offset(1, 0) Like "RUN *" Then
                            .Offset(0, 9).FormulaR1C1 = "=LEFT(R[1]C[-9],(FIND(""RUN "",R[1]C[-9],1)-1))"
                        End If
                    End If
                End If
            End With
            Next Lrow            
    End With
    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With
End Sub

Thanks again for your help.

Thanks a million Leith I will test it tomorrow and let you know the results.

Thanks Leith your code does cut a few seconds off my time.

Ok thanks I will in the future.