cell select

R

ranswert

I have written the following procedure:

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, 3)).Select
mergecells
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Select
mergecells
ActiveCell.EntireRow.Cells(11).Value = cboxno
ActiveCell.Offset(0, -4).Select
Selection.RowHeight = 12.75
Selection.Font.Bold = False
Selection.Font.Size = 10
Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 5)).Select
Selection.Font.Bold = False
Range(ActiveCell.Offset(0, -2), ActiveCell.Offset(0, 4)).Select
addborders
ActiveCell.Offset(0, 1).Select
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 3)).Select
Selection.Locked = False
Range(ActiveCell.Offset(0, 3), ActiveCell.Offset(0, 4)).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, -6).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

When the procedure is done and i press the enter key the curser move up a
few rows and over one column instead of moving to the right one column. I
have the settings set for the curser to move to the right when it is pressed.
If I don't have the sheet protected it moves to the right. The cells are
not locked either. What do I need to do to get it to move right?
Thanks
 
R

ranswert

Also, is there a way to make this procedure shorter? It's a little slow.
Maybe there is a faster way to make it work.
 
J

Jean-Yves

Hello,

Basically, this written procedure looks like the result of the macro recorder.
Like :
range.select
select. dop something
Why select. Just do it on the same line
That is a start to gain processing time.
The next thing to make it faster is to stop the screen update before your
procedure runs
application.Screenupdating = false
'code
application.Screenupdating = True



--
Regards

Jean-Yves Tfelt
Europe


ranswert said:
Also, is there a way to make this procedure shorter? It's a little slow.
Maybe there is a faster way to make it work.

ranswert said:
I have written the following procedure:

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, 3)).Select
mergecells
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Select
mergecells
ActiveCell.EntireRow.Cells(11).Value = cboxno
ActiveCell.Offset(0, -4).Select
Selection.RowHeight = 12.75
Selection.Font.Bold = False
Selection.Font.Size = 10
Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 5)).Select
Selection.Font.Bold = False
Range(ActiveCell.Offset(0, -2), ActiveCell.Offset(0, 4)).Select
addborders
ActiveCell.Offset(0, 1).Select
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 3)).Select
Selection.Locked = False
Range(ActiveCell.Offset(0, 3), ActiveCell.Offset(0, 4)).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, -6).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

When the procedure is done and i press the enter key the curser move up a
few rows and over one column instead of moving to the right one column. I
have the settings set for the curser to move to the right when it is pressed.
If I don't have the sheet protected it moves to the right. The cells are
not locked either. What do I need to do to get it to move right?
Thanks
Click to expand...
Click to expand...
 
P

Per Jessen

ranswert said:
Also, is there a way to make this procedure shorter? It's a little slow.
Maybe there is a faster way to make it work.

ranswert said:
I have written the following procedure:

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, 3)).Select
mergecells
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Select
mergecells
ActiveCell.EntireRow.Cells(11).Value = cboxno
ActiveCell.Offset(0, -4).Select
Selection.RowHeight = 12.75
Selection.Font.Bold = False
Selection.Font.Size = 10
Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 5)).Select
Selection.Font.Bold = False
Range(ActiveCell.Offset(0, -2), ActiveCell.Offset(0, 4)).Select
addborders
ActiveCell.Offset(0, 1).Select
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 3)).Select
Selection.Locked = False
Range(ActiveCell.Offset(0, 3), ActiveCell.Offset(0, 4)).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, -6).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

When the procedure is done and i press the enter key the curser move up a
few rows and over one column instead of moving to the right one column.
I
have the settings set for the curser to move to the right when it is
pressed.
If I don't have the sheet protected it moves to the right. The cells
are
not locked either. What do I need to do to get it to move right?
Thanks
Click to expand...
Click to expand...

Hi

Setting Application.Screenupdating=false will speed your code up, just
remember to set it =True at the end of your code.

Also refering to the cells rather than selecting the cells will boost the
code.

I have tried to apply the consderations above into your code, see below.
Though, I am not sure all the "Offset" statements are offsetting to the
right cells, but I will leave that to you...

Regards,
Per


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

Application.ScreenUpdating = True
End Sub
 
R

ranswert

I will give that a try.
Thanks for your help

Per Jessen said:
ranswert said:
Also, is there a way to make this procedure shorter? It's a little slow.
Maybe there is a faster way to make it work.

ranswert said:
I have written the following procedure:

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, 3)).Select
mergecells
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Select
mergecells
ActiveCell.EntireRow.Cells(11).Value = cboxno
ActiveCell.Offset(0, -4).Select
Selection.RowHeight = 12.75
Selection.Font.Bold = False
Selection.Font.Size = 10
Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 5)).Select
Selection.Font.Bold = False
Range(ActiveCell.Offset(0, -2), ActiveCell.Offset(0, 4)).Select
addborders
ActiveCell.Offset(0, 1).Select
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 3)).Select
Selection.Locked = False
Range(ActiveCell.Offset(0, 3), ActiveCell.Offset(0, 4)).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, -6).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

When the procedure is done and i press the enter key the curser move up a
few rows and over one column instead of moving to the right one column.
I
have the settings set for the curser to move to the right when it is
pressed.
If I don't have the sheet protected it moves to the right. The cells
are
not locked either. What do I need to do to get it to move right?
Thanks
Click to expand...
Click to expand...

Hi

Setting Application.Screenupdating=false will speed your code up, just
remember to set it =True at the end of your code.

Also refering to the cells rather than selecting the cells will boost the
code.

I have tried to apply the consderations above into your code, see below.
Though, I am not sure all the "Offset" statements are offsetting to the
right cells, but I will leave that to you...

Regards,
Per


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

Application.ScreenUpdating = True
End Sub
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

Slow Procedure 5
Select contiguous cells by ActiveCell.Interior.ColorIndex and applyborders 7
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
exporting to Excel without overwriting the macros 4
Hlp! Adv Filter - Non-Contiguous rows don't copy 11
Create Detail Sheets from Pivot Table 1

Top