Shorter Sub

P

Pete

Is there an easier way to achieve this? All it does it
take the resulting value from the formula in one column
and stores it as a Value in the next Column.

I need to keep it as a value, as it accumulates
throughout the week, and the sheet it comes from is
cleared every day.

Hope you can understand what I mean, I am very
inexperienced with VBA

Pete

Private Sub MinorStops()
Dim TotalBagshooter(16) As Long, DailyBagShooter(16) As
Long
Dim TotalDischargeBelt(16) As Long, DailyDischargeBelt
(16) As Long
Dim TotalFlatBeltConv(16) As Long, DailyFlatBeltConv(16)
As Long
Dim TotalBagHeight(16) As Long, DailyBagHeight(16) As Long
Dim TotalProfileBoard(16) As Long, DailyProfileBoard(16)
As Long
Dim Ctr
Ctr = 0

For Ctr = 1 To 16
DailyBagShooter(Ctr) = Sheets("MinorStops").Cells(1 +
Ctr, 2).Value
TotalBagshooter(Ctr) = Sheets("MinorStops").Cells(1 +
Ctr, 3).Value
TotalBagshooter(Ctr) = TotalBagshooter(Ctr) +
DailyBagShooter(Ctr)
Sheets("MinorStops").Cells(1 + Ctr, 3).Value =
TotalBagshooter(Ctr)
Next Ctr

Ctr = 0
For Ctr = 1 To 16
DailyDischargeBelt(Ctr) = Sheets("MinorStops").Cells
(1 + Ctr, 4).Value
TotalDischargeBelt(Ctr) = Sheets("MinorStops").Cells
(1 + Ctr, 5).Value
TotalDischargeBelt(Ctr) = TotalDischargeBelt(Ctr) +
DailyDischargeBelt(Ctr)
Sheets("MinorStops").Cells(1 + Ctr, 5).Value =
TotalDischargeBelt(Ctr)
Next Ctr

Ctr = 0
For Ctr = 1 To 16
DailyFlatBeltConv(Ctr) = Sheets("MinorStops").Cells(1
+ Ctr, 6).Value
TotalFlatBeltConv(Ctr) = Sheets("MinorStops").Cells(1
+ Ctr, 7).Value
TotalFlatBeltConv(Ctr) = TotalFlatBeltConv(Ctr) +
DailyFlatBeltConv(Ctr)
Sheets("MinorStops").Cells(1 + Ctr, 7).Value =
TotalFlatBeltConv(Ctr)
Next Ctr

Ctr = 0
For Ctr = 1 To 16
DailyBagHeight(Ctr) = Sheets("MinorStops").Cells(1 +
Ctr, 8).Value
TotalBagHeight(Ctr) = Sheets("MinorStops").Cells(1 +
Ctr, 9).Value
TotalBagHeight(Ctr) = TotalBagHeight(Ctr) +
DailyBagHeight(Ctr)
Sheets("MinorStops").Cells(1 + Ctr, 9).Value =
TotalBagHeight(Ctr)
Next Ctr

Ctr = 0
For Ctr = 1 To 16
DailyProfileBoard(Ctr) = Sheets("MinorStops").Cells(1
+ Ctr, 10).Value
TotalProfileBoard(Ctr) = Sheets("MinorStops").Cells(1
+ Ctr, 11).Value
TotalProfileBoard(Ctr) = TotalProfileBoard(Ctr) +
DailyProfileBoard(Ctr)
Sheets("MinorStops").Cells(1 + Ctr, 11).Value =
TotalProfileBoard(Ctr)
Next Ctr

End Sub
 
F

Fredrik Wahlgren

Pete said:
Is there an easier way to achieve this? All it does it
take the resulting value from the formula in one column
and stores it as a Value in the next Column.

I need to keep it as a value, as it accumulates
throughout the week, and the sheet it comes from is
cleared every day.

Hope you can understand what I mean, I am very
inexperienced with VBA

Pete

Private Sub MinorStops()
Dim TotalBagshooter(16) As Long, DailyBagShooter(16) As
Long
Dim TotalDischargeBelt(16) As Long, DailyDischargeBelt
(16) As Long
Dim TotalFlatBeltConv(16) As Long, DailyFlatBeltConv(16)
As Long
Dim TotalBagHeight(16) As Long, DailyBagHeight(16) As Long
Dim TotalProfileBoard(16) As Long, DailyProfileBoard(16)
As Long
Dim Ctr
Ctr, 2).Value
TotalBagshooter(Ctr) = Sheets("MinorStops").Cells(1 +
Ctr, 3).Value
TotalBagshooter(Ctr) = TotalBagshooter(Ctr) +
DailyBagShooter(Ctr)
Sheets("MinorStops").Cells(1 + Ctr, 3).Value =
TotalBagshooter(Ctr)Ctr = 0

For Ctr = 1 To 16
Click to expand...
Next Ctr

Ctr = 0
For Ctr = 1 To 16
DailyDischargeBelt(Ctr) = Sheets("MinorStops").Cells
(1 + Ctr, 4).Value
TotalDischargeBelt(Ctr) = Sheets("MinorStops").Cells
(1 + Ctr, 5).Value
TotalDischargeBelt(Ctr) = TotalDischargeBelt(Ctr) +
DailyDischargeBelt(Ctr)
Sheets("MinorStops").Cells(1 + Ctr, 5).Value =
TotalDischargeBelt(Ctr)
Next Ctr

Ctr = 0
For Ctr = 1 To 16
DailyFlatBeltConv(Ctr) = Sheets("MinorStops").Cells(1
+ Ctr, 6).Value
TotalFlatBeltConv(Ctr) = Sheets("MinorStops").Cells(1
+ Ctr, 7).Value
TotalFlatBeltConv(Ctr) = TotalFlatBeltConv(Ctr) +
DailyFlatBeltConv(Ctr)
Sheets("MinorStops").Cells(1 + Ctr, 7).Value =
TotalFlatBeltConv(Ctr)
Next Ctr

Ctr = 0
For Ctr = 1 To 16
DailyBagHeight(Ctr) = Sheets("MinorStops").Cells(1 +
Ctr, 8).Value
TotalBagHeight(Ctr) = Sheets("MinorStops").Cells(1 +
Ctr, 9).Value
TotalBagHeight(Ctr) = TotalBagHeight(Ctr) +
DailyBagHeight(Ctr)
Sheets("MinorStops").Cells(1 + Ctr, 9).Value =
TotalBagHeight(Ctr)
Next Ctr

Ctr = 0
For Ctr = 1 To 16
DailyProfileBoard(Ctr) = Sheets("MinorStops").Cells(1
+ Ctr, 10).Value
TotalProfileBoard(Ctr) = Sheets("MinorStops").Cells(1
+ Ctr, 11).Value
TotalProfileBoard(Ctr) = TotalProfileBoard(Ctr) +
DailyProfileBoard(Ctr)
Sheets("MinorStops").Cells(1 + Ctr, 11).Value =
TotalProfileBoard(Ctr)
Next Ctr

End Sub
Click to expand...

It seems you are doing pretty much the same thing 5 times. This means that
you could use a nested loop

For i = 1 to 5
Ctr = 0
For Ctr = 1 To 16
'Your code here. Some of the constants should be calculated from the
varaiable i
Next Ctr
Next i

/Fredrik
 
T

Tushar Mehta

There are other ways that better leverage the XL object model that
would be more appropriate if your data set was really large. But, as
things stand:

Option Explicit

Sub CumulativeSave(SrcCells As Range)
Dim i As Long
For i = 1 To SrcCells.Rows.Count
SrcCells.Offset(0, 1)(i).Value = _
SrcCells.Offset(0, 1)(i).Value + SrcCells(i).Value
Next i
End Sub
Sub MinorStops()
Dim Ctr As Byte
For Ctr = 1 To 5
CumulativeSave _
Sheets("MinorStops").Cells(2, (Ctr - 1) * 2 + 2) _
.Resize(16, 1)
Next Ctr
End Sub


--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions
 
P

Pete

Hi,

Pardon my ignorance, but how would I initiate the
CumulativeSave Sub?

CumulativeSave("B2:B17")?

Pete
 
T

Tushar Mehta

You start MinorStops. It, in turn, calls the Cumulative sub.

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions

Hi,

Pardon my ignorance, but how would I initiate the
CumulativeSave Sub?

CumulativeSave("B2:B17")?

Pete
Click to expand...
{snip}
 
P

Pete

Don't suppose you could give me a run down on how it
works could you, I may need to adapt it for another part
of my sheet.

Thanks

Pete
 
T

Tushar Mehta

Check XL VBA help for 'Calling Sub and Function Procedures' It does a
pretty good job of explaining subroutines/functions with arguments and
how to call them.

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions
 

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

Sub 1
Arrays and Checkboxes 3
Macro not repeating output from search function 4
Need help with macro 12
Instr 2
Interrupting a Loop 5
Listbox Help 2
Help with VB code to compare two columns 3

Top