Slow Procedure

R

ranswert

I have been slowly adding to the following procedure and now it runs real
slow. Is there a better way to write it to speed it up?

Sub addestimateitem()
Dim cboxno, itemno As Integer
unprotectsheet
itemno = ActiveSheet.Range("estitemnum") + 1
Range("estitemnum").Value = itemno
cboxno = ActiveSheet.Range("estcboxnum") + 1
Range("estcboxnum").Value = cboxno
Range("esttotal").Select
ActiveCell.Offset(itemno, 0).Name = "esttotalamt"
Range("estno").Select
ActiveCell.Offset(itemno, 0).Select
Selection.EntireRow.Insert
ActiveCell.Value = itemno
Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 4)).Select
mergecells
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 3)).Select
mergecells
ActiveCell.EntireRow.Cells(13).Value = cboxno
ActiveCell.Offset(0, -5).Select
Selection.RowHeight = 12.75
Selection.Font.Bold = False
Selection.Font.Size = 10
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 9)).Select
addborders
ActiveCell.Offset(0, 1).Select
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 7)).Select
Selection.Locked = False
Range(ActiveCell.Offset(0, 4), ActiveCell.Offset(0, 5)).Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IF(RC[2],RC[-1],0)"
ActiveCell.Offset(0, -8).Select
addcheckbox
Range("esttotal").Select
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(itemno, 0)).Select
Selection.Name = "esttotalscol"
Range("esttotalamt").Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveCell.FormulaR1C1 = "=sum(esttotalscol)"
Range("estsubven").Select
ActiveCell.Offset(itemno, 0).Select
protectsheet


End Sub

Thank You
 
J

John Keith

The easiest thing to try is this... (otherwise you need to restructure the
logic to avoid ".select" and the multiple "ActiveCell." style of syntax.)

At the top add:
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

At the bottom add:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With


HTH
 
D

Don Guillett

try to eliminate the selections.
Range("esttotal").Offset(itemno, 0).Name = "esttotalamt"
Range("estno").Offset(itemno, 0).EntireRow.Insert
 
R

ranswert

Thanks
any reccomendations on how I can and change cells without .select.


John Keith said:
The easiest thing to try is this... (otherwise you need to restructure the
logic to avoid ".select" and the multiple "ActiveCell." style of syntax.)

At the top add:
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

At the bottom add:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With


HTH
--
Regards,
John


ranswert said:
I have been slowly adding to the following procedure and now it runs real
slow. Is there a better way to write it to speed it up?

Sub addestimateitem()
Dim cboxno, itemno As Integer
unprotectsheet
itemno = ActiveSheet.Range("estitemnum") + 1
Range("estitemnum").Value = itemno
cboxno = ActiveSheet.Range("estcboxnum") + 1
Range("estcboxnum").Value = cboxno
Range("esttotal").Select
ActiveCell.Offset(itemno, 0).Name = "esttotalamt"
Range("estno").Select
ActiveCell.Offset(itemno, 0).Select
Selection.EntireRow.Insert
ActiveCell.Value = itemno
Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 4)).Select
mergecells
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 3)).Select
mergecells
ActiveCell.EntireRow.Cells(13).Value = cboxno
ActiveCell.Offset(0, -5).Select
Selection.RowHeight = 12.75
Selection.Font.Bold = False
Selection.Font.Size = 10
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 9)).Select
addborders
ActiveCell.Offset(0, 1).Select
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 7)).Select
Selection.Locked = False
Range(ActiveCell.Offset(0, 4), ActiveCell.Offset(0, 5)).Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IF(RC[2],RC[-1],0)"
ActiveCell.Offset(0, -8).Select
addcheckbox
Range("esttotal").Select
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(itemno, 0)).Select
Selection.Name = "esttotalscol"
Range("esttotalamt").Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveCell.FormulaR1C1 = "=sum(esttotalscol)"
Range("estsubven").Select
ActiveCell.Offset(itemno, 0).Select
protectsheet


End Sub

Thank You
Click to expand...
Click to expand...
 
R

Rick Rothstein \(MVP - VB\)

One example...

Range("esttotal").Select
ActiveCell.Offset(itemno, 0).Name = "esttotalamt"

The above can be replaced with...

Range("esttotal").Offset(itemno, 0).Name = "esttotalamt"

One other note; this line....

Dim cboxno, itemno As Integer

is not doing what you think. Only itemno is declared as an Integer; cboxno defaults to a Variant. In VB/VBA, one must explicitly declare each variable or it defaults to Variant. So, you should do either this...

Dim cboxno As Integer, itemno As Integer

or this....

Dim cboxno As Integer
Dim itemno As Integer

Rick



ranswert said:
Thanks
any reccomendations on how I can and change cells without .select.


John Keith said:
The easiest thing to try is this... (otherwise you need to restructure the
logic to avoid ".select" and the multiple "ActiveCell." style of syntax.)

At the top add:
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

At the bottom add:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With


HTH
--
Regards,
John


ranswert said:
I have been slowly adding to the following procedure and now it runs real
slow. Is there a better way to write it to speed it up?

Sub addestimateitem()
Dim cboxno, itemno As Integer
unprotectsheet
itemno = ActiveSheet.Range("estitemnum") + 1
Range("estitemnum").Value = itemno
cboxno = ActiveSheet.Range("estcboxnum") + 1
Range("estcboxnum").Value = cboxno
Range("esttotal").Select
ActiveCell.Offset(itemno, 0).Name = "esttotalamt"
Range("estno").Select
ActiveCell.Offset(itemno, 0).Select
Selection.EntireRow.Insert
ActiveCell.Value = itemno
Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 4)).Select
mergecells
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 3)).Select
mergecells
ActiveCell.EntireRow.Cells(13).Value = cboxno
ActiveCell.Offset(0, -5).Select
Selection.RowHeight = 12.75
Selection.Font.Bold = False
Selection.Font.Size = 10
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 9)).Select
addborders
ActiveCell.Offset(0, 1).Select
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 7)).Select
Selection.Locked = False
Range(ActiveCell.Offset(0, 4), ActiveCell.Offset(0, 5)).Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IF(RC[2],RC[-1],0)"
ActiveCell.Offset(0, -8).Select
addcheckbox
Range("esttotal").Select
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(itemno, 0)).Select
Selection.Name = "esttotalscol"
Range("esttotalamt").Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveCell.FormulaR1C1 = "=sum(esttotalscol)"
Range("estsubven").Select
ActiveCell.Offset(itemno, 0).Select
protectsheet


End Sub

Thank You
Click to expand...
Click to expand...
Click to expand...
 
R

ranswert

Thanks I will give it a try.

Rick Rothstein (MVP - VB) said:
One example...

Range("esttotal").Select
ActiveCell.Offset(itemno, 0).Name = "esttotalamt"

The above can be replaced with...

Range("esttotal").Offset(itemno, 0).Name = "esttotalamt"

One other note; this line....

Dim cboxno, itemno As Integer

is not doing what you think. Only itemno is declared as an Integer; cboxno defaults to a Variant. In VB/VBA, one must explicitly declare each variable or it defaults to Variant. So, you should do either this...

Dim cboxno As Integer, itemno As Integer

or this....

Dim cboxno As Integer
Dim itemno As Integer

Rick



ranswert said:
Thanks
any reccomendations on how I can and change cells without .select.


John Keith said:
The easiest thing to try is this... (otherwise you need to restructure the
logic to avoid ".select" and the multiple "ActiveCell." style of syntax.)

At the top add:
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

At the bottom add:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With


HTH
--
Regards,
John


:

I have been slowly adding to the following procedure and now it runs real
slow. Is there a better way to write it to speed it up?

Sub addestimateitem()
Dim cboxno, itemno As Integer
unprotectsheet
itemno = ActiveSheet.Range("estitemnum") + 1
Range("estitemnum").Value = itemno
cboxno = ActiveSheet.Range("estcboxnum") + 1
Range("estcboxnum").Value = cboxno
Range("esttotal").Select
ActiveCell.Offset(itemno, 0).Name = "esttotalamt"
Range("estno").Select
ActiveCell.Offset(itemno, 0).Select
Selection.EntireRow.Insert
ActiveCell.Value = itemno
Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 4)).Select
mergecells
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 3)).Select
mergecells
ActiveCell.EntireRow.Cells(13).Value = cboxno
ActiveCell.Offset(0, -5).Select
Selection.RowHeight = 12.75
Selection.Font.Bold = False
Selection.Font.Size = 10
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 9)).Select
addborders
ActiveCell.Offset(0, 1).Select
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 7)).Select
Selection.Locked = False
Range(ActiveCell.Offset(0, 4), ActiveCell.Offset(0, 5)).Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IF(RC[2],RC[-1],0)"
ActiveCell.Offset(0, -8).Select
addcheckbox
Range("esttotal").Select
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(itemno, 0)).Select
Selection.Name = "esttotalscol"
Range("esttotalamt").Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveCell.FormulaR1C1 = "=sum(esttotalscol)"
Range("estsubven").Select
ActiveCell.Offset(itemno, 0).Select
protectsheet


End Sub

Thank You
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

cell select 4
Data samples 3
Select contiguous cells by ActiveCell.Interior.ColorIndex and applyborders 7
exporting to Excel without overwriting the macros 4
Help with VBA to find data delete it change font, add lines then looptill end of file 4
Macro Creates Mult Sheets Based on Summary 2
A Macro for Multiple Sheets that Reference one Summary Page 1
Hlp! Adv Filter - Non-Contiguous rows don't copy 11

Top