Code takes to long

O

Oggy

Hi

I have the following code that takes an age to process when i have
alot of items (5000 takes approx 1 hour.). Is there a more efficent
way i can process this? I am using Excel 2007 and writing in formulars
to the qtys of items i have inserted.

Sub newsystemorder()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Do While ActiveCell.Value <> ""
ActiveCell.Offset(0, 0).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 1).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 2).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 3).FormulaR1C1 = "=RC[-1]-
(RC[1]+RC[2]+RC[3]+RC[4]+RC[5])"
ActiveCell.Offset(0, 3).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 4).FormulaR1C1 = "=SUM(Drawing!RC[6]:RC[7])-rc[1]-
rc[2]-rc[3]-rc[4]"
ActiveCell.Offset(0, 4).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 5).FormulaR1C1 = "=sum(Manufacture!RC[5]:RC[6])-
rc[1]-rc[2]-rc[3]"
ActiveCell.Offset(0, 5).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 6).FormulaR1C1 = "=sum('Sub Contract'!
RC[7]:RC[8])-rc[1]-rc[2]"
ActiveCell.Offset(0, 6).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 7).FormulaR1C1 = "=sum(Recieved!RC[3]:RC[4])-
rc[1]"
ActiveCell.Offset(0, 7).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 8).FormulaR1C1 = "=sum(Delivery!RC[2]:RC[3])"
ActiveCell.Offset(0, 8).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 9).FormulaR1C1 = "=RC[-7]-RC[-1]"
ActiveCell.Offset(0, 9).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 47).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 48).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 49).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 50).FormulaR1C1 = "=RC4*RC48"
ActiveCell.Offset(0, 50).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 51).FormulaR1C1 = "=RC5*RC48"
ActiveCell.Offset(0, 51).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 52).FormulaR1C1 = "=RC6*RC48"
ActiveCell.Offset(0, 52).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 53).FormulaR1C1 = "=RC7*RC48"
ActiveCell.Offset(0, 53).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 54).FormulaR1C1 = "=RC8*RC48"
ActiveCell.Offset(0, 54).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 55).FormulaR1C1 = "=RC9*RC48"
ActiveCell.Offset(0, 55).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 56).FormulaR1C1 = "=SUM(RC[-6]:RC[-1])"
ActiveCell.Offset(0, 56).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic



ETC.........




Thanks in advace

Addy
 
B

Bob Phillips

Sub newsystemorder()
Dim LastRow As Long

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet

LastRow = .Cells(.Rows.Count, ActiveCell.Column).End(xlUp).Row
End With
With ActiveCell
With .Resize(LastRow - .Row + 1, 10)
.BorderAround LineStyle:=xlContinuous, _
Weight:=xlThin, _
ColorIndex:=xlAutomatic
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
With .Offset(0, 47).Resize(LastRow - .Row + 1, 10)
.BorderAround LineStyle:=xlContinuous, _
Weight:=xlThin, _
ColorIndex:=xlAutomatic
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
.Offset(0, 3).Resize(LastRow - .Row + 1, 10).FormulaR1C1 =
"=RC[-1]-(RC[1]+RC[2]+RC[3]+RC[4]+RC[5])"
.Offset(0, 4).Resize(LastRow - .Row + 1, 10).FormulaR1C1 =
"=SUM(Drawing!RC[6]:RC[7])-rc[1]-rc[2]-rc[3]-rc[4]"
.Offset(0, 5).Resize(LastRow - .Row + 1, 10).FormulaR1C1 =
"=sum(Manufacture!RC[5]:RC[6])-rc[1]-rc[2]-rc[3]"
.Offset(0, 6).Resize(LastRow - .Row + 1, 10).FormulaR1C1 =
"=sum('Sub Contract'!RC[7]:RC[8])-rc[1]-rc[2]"
.Offset(0, 7).Resize(LastRow - .Row + 1, 10).FormulaR1C1 =
"=sum(Recieved!RC[3]:RC[4])-rc[1]"
.Offset(0, 8).Resize(LastRow - .Row + 1, 10).FormulaR1C1 =
"=sum(Delivery!RC[2]:RC[3])"
.Offset(0, 9).Resize(LastRow - .Row + 1, 10).FormulaR1C1 =
"=RC[-7]-RC[-1]"
.Offset(0, 50).Resize(LastRow - .Row + 1, 10).FormulaR1C1 =
"=RC4*RC48"
.Offset(0, 51).Resize(LastRow - .Row + 1, 10).FormulaR1C1 =
"=RC5*RC48"
.Offset(0, 52).Resize(LastRow - .Row + 1, 10).FormulaR1C1 =
"=RC6*RC48"
.Offset(0, 53).Resize(LastRow - .Row + 1, 10).FormulaR1C1 =
"=RC7*RC48"
.Offset(0, 54).Resize(LastRow - .Row + 1, 10).FormulaR1C1 =
"=RC8*RC48"
.Offset(0, 55).Resize(LastRow - .Row + 1, 10).FormulaR1C1 =
"=RC9*RC48"
.Offset(0, 56).Resize(LastRow - .Row + 1, 10).FormulaR1C1 =
"=SUM(RC[-6]:RC[-1])"
End With
End Sub

--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)



Oggy said:
Hi

I have the following code that takes an age to process when i have
alot of items (5000 takes approx 1 hour.). Is there a more efficent
way i can process this? I am using Excel 2007 and writing in formulars
to the qtys of items i have inserted.

Sub newsystemorder()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Do While ActiveCell.Value <> ""
ActiveCell.Offset(0, 0).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 1).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 2).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 3).FormulaR1C1 = "=RC[-1]-
(RC[1]+RC[2]+RC[3]+RC[4]+RC[5])"
ActiveCell.Offset(0, 3).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 4).FormulaR1C1 = "=SUM(Drawing!RC[6]:RC[7])-rc[1]-
rc[2]-rc[3]-rc[4]"
ActiveCell.Offset(0, 4).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 5).FormulaR1C1 = "=sum(Manufacture!RC[5]:RC[6])-
rc[1]-rc[2]-rc[3]"
ActiveCell.Offset(0, 5).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 6).FormulaR1C1 = "=sum('Sub Contract'!
RC[7]:RC[8])-rc[1]-rc[2]"
ActiveCell.Offset(0, 6).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 7).FormulaR1C1 = "=sum(Recieved!RC[3]:RC[4])-
rc[1]"
ActiveCell.Offset(0, 7).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 8).FormulaR1C1 = "=sum(Delivery!RC[2]:RC[3])"
ActiveCell.Offset(0, 8).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 9).FormulaR1C1 = "=RC[-7]-RC[-1]"
ActiveCell.Offset(0, 9).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 47).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 48).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 49).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 50).FormulaR1C1 = "=RC4*RC48"
ActiveCell.Offset(0, 50).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 51).FormulaR1C1 = "=RC5*RC48"
ActiveCell.Offset(0, 51).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 52).FormulaR1C1 = "=RC6*RC48"
ActiveCell.Offset(0, 52).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 53).FormulaR1C1 = "=RC7*RC48"
ActiveCell.Offset(0, 53).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 54).FormulaR1C1 = "=RC8*RC48"
ActiveCell.Offset(0, 54).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 55).FormulaR1C1 = "=RC9*RC48"
ActiveCell.Offset(0, 55).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveCell.Offset(0, 56).FormulaR1C1 = "=SUM(RC[-6]:RC[-1])"
ActiveCell.Offset(0, 56).BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, ColorIndex:=xlAutomatic



ETC.........




Thanks in advace

Addy
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

Code takes to long to process Excel 2007 1
Border formatting row of cells 22
help needed with borders 2
Hlp! Adv Filter - Non-Contiguous rows don't copy 11
JLatham MVP (Macro) 3
CONDITIONAL FORMATTING FOR MORE THAN 3 CRITERIA 1
Shorten a Macro 7
Weird problem with conditional format 4

Top