Help to speed up this macro

[Jim G]

I have the following macro that runsa a UDF to delete blank rows (every other
row). The formula is inserted in cell E11 and copied down for for each line
where Col B is not empty. It works just fine, however, there are only 100+
lines and it runs very slowly. Is there something Ican do to speed it up?

Sub BudgetJobNo()
'
Sheets("Budget").Select

Call RowsJoinData(2) '<where column 2 (B) is blank for every row to delete

Application.DisplayAlerts = False
Application.ScreenUpdating = False

JobNo = "=IF(ISERROR(LEFT(Budget!B11,FIND(""
"",Budget!B11)-1))=FALSE,LEFT(Budget!B11,FIND("" "",Budget!B11)-1),"" "")"
Range("E11").Value = JobNo

'And then copy them down to the last line.
Range("e11:e11").Select
Selection.Copy
CR = 11
Do While Cells(CR, 2) <> ""
Range(Cells(CR, 5), Cells(CR, 5)).Select
ActiveSheet.Paste
CR = CR + 1
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub

 

[atpgroups]

 The formula is inserted in cell E11 and copied down for for each line
where Col B is not empty.  It works just fine, however, there are only 100+
lines and it runs very slowly.  Is there something Ican do to speed it up?

A number of things spring to mind..
Do you need the equation in the cells, or just the result?

As a first step to speeding things up, do away with all the copy/paste
stuff.

ie replace this bit ...

    JobNo = "=IF(ISERROR(LEFT(Budget!B11,FIND(""
"",Budget!B11)-1))=FALSE,LEFT(Budget!B11,FIND("" "",Budget!B11)-1),"" "")"
    Range("E11").Value = JobNo
    Range("e11:e11").Select
    Selection.Copy
    CR = 11
    Do While Cells(CR, 2) <> ""
        Range(Cells(CR, 5), Cells(CR, 5)).Select
        ActiveSheet.Paste
        CR = CR + 1
    Loop

With...

JobNo = "=IF(ISERROR(LEFT(Budget!B11,FIND("""",Budget!
B11)-1))=FALSE,LEFT(Budget!B11,FIND("" "",Budget!B11)-1),"" "")"
CR = 11
Do While Cells(CR, 2) <> ""
Cells(CR, 5).Value = JobNo
CR = CR + 1
Loop

Not that I have bothered to test this, so it might be wrong in detail,
though right in principle.

 

[Jim G]

Thanks for that,
I probably don't need the formulas, but I like to chck that users haven't
typed over a result.

I haven't tested you solution but I can see the logic.

In the meantime, I'd manged to come up with this whcih seemed to do the trick:

Sub BudgetJobNo()
'
' BudgetJobNo Macro
'
Dim myRange As String

Sheets("Budget").Select

Call RowsJoinData(2) '<where column 2 (B) is blank for every row to delete

Application.DisplayAlerts = False
Application.ScreenUpdating = False

lastrow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
myRange = "(" & "E11:E" & lastrow & ")"
JobNo = "=IF(ISERROR(LEFT(Budget!B11,FIND(""
"",Budget!B11)-1))=FALSE,LEFT(Budget!B11,FIND("" "",Budget!B11)-1),"" "")"
Range("E11").Value = JobNo

'And then copy them down to the last line.
Range(myRange).Select
Selection.FillDown
Range("E11").Select

Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub

 

[atpgroups]

    'And then copy them down to the last line.
    Range(myRange).Select
    Selection.FillDown
    Range("E11").Select

Try to avoid selecting stuff to work on it. If the user clicks a cell
or changes sheets it all goes wrong.

This will do pretty much the same thing as you have done there
regardless of which sheet is at the front, or what else is happening.

Range(myRange, Myrange.end(xlDown)).Value = JobNo

 

[Gary Keramidas]

try turning off calculation at the beginning and turning it back on when you're
done
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With


' your code

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