PDA

View Full Version : Reducing the need for Multiple hardline codes



jcrain2v
05-02-2017, 02:29 PM
I have financial spreadsheet to keep track of the daily cost of a project from start to finish. Writing a code for say all the C3's was simply enough. How can I apply a macro to do this for the next 40 lines so I dont have to hardline it 44 times?


Sub updatethesum()
Dim ws As Worksheet
Dim i As Double
i = 0
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Total" Then
i = i + ws.Range("c3")
End If
Next
Sheets("Total").Range("c3") = i
End Sub

mdmackillop
05-02-2017, 03:01 PM
Sub updatethesum()
Dim ws As Worksheet
Dim i As Double
Dim j As Long

For j = 3 To 43
i = 0
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Total" Then
i = i + ws.Range("c" & j)
End If
Next
Sheets("Total").Range("c" & j) = i
Next j
End Sub

jcrain2v
05-02-2017, 03:14 PM
Thanks mdmackillop. I'm new to VBA. I've used a little Fortran for my graduate in civil engineering and programmed a TI89 calc that is all. What would happened it I changed double to long for i?

mdmackillop
05-02-2017, 03:21 PM
Long is an integer value so you would lose decimals, if any, from your data.

jcrain2v
05-02-2017, 03:36 PM
Okay! This spreadsheet uses whole numbers, even though given how simple it is it really wouldn't make a difference. Can I repeat this code for two more columns in the totals sheet and add say "k" and "l", adjust and add if statements accordingly? ie. k=k+ws.Range ("e"&j)

next J
next k
next l

mdmackillop
05-02-2017, 03:43 PM
An alternative to put formulae in the cells

Sub Test()
Dim x As String
x = Sheets(Sheets.Count).Name
Sheets("Total").Range("C3:C42").FormulaR1C1 = "=SUM('Sheet2:" & x & "'!RC)"
End Sub

SamT
05-02-2017, 03:57 PM
Sub Alternate_updatethesum()
Dim ws As Worksheet
Dim i As Long

With Sheets("Total")
For Each ws In ThisWorkbook.Worksheets
For i = 3 To 43
If ws.Name <> "Total" Then
.Range("C" & i) = .Range("C" & i) + ws.Range("c" & i) 'Edit to suit
.Range("D" & i) = .Range("D" & i) + ws.Range("D" & i)
.Range("E" & i) = .Range("E" & i) + ws.Range("E" & i)
.Range("F" & i) = .Range("F" & i) + ws.Range("c" & i)
.Range("G" & i) = .Range("C" & i) + ws.Range("c" & i)
.Range("C" & i) = .Range("C" & i) + ws.Range("c" & i)
.Range("C" & i) = .Range("C" & i) + ws.Range("c" & i)
.Range("C" & i) = .Range("C" & i) + ws.Range("c" & i)
.Range("C" & i) = .Range("C" & i) + ws.Range("c" & i)
.Range("C" & i) = .Range("C" & i) + ws.Range("c" & i)
.Range("C" & i) = .Range("C" & i) + ws.Range("c" & i)
.Range("C" & i) = .Range("C" & i) + ws.Range("c" & i)
.Range("C" & i) = .Range("C" & i) + ws.Range("c" & i)
.Range("C" & i) = .Range("C" & i) + ws.Range("c" & i)
.Range("C" & i) = .Range("C" & i) + ws.Range("c" & i)
End If
Next
Next
End With
End Sub

jcrain2v
05-02-2017, 04:03 PM
Nice! Seeing Both of these is definitely helping me to understand how logic works with VBA. Sam T, you just gave me an idea on how to code the next thing I want to do.

mdmackillop
05-02-2017, 04:08 PM
For multiple columns

Sub Test1()
Dim x As String
Dim i As Long
x = Sheets(Sheets.Count).Name
For i = 0 To 8 'change to suit
Sheets("Total").Range("C3:C42").Offset(, i).FormulaR1C1 = "=SUM('Sheet2:" & x & "'!RC)"
Next i
End Sub

jcrain2v
05-02-2017, 04:23 PM
I'm gonna have to learn a little more about how some of that code works for your alternatives mdmackillop.

mdmackillop
05-02-2017, 04:45 PM
Offset is simply Offset(row,column). Row can be omitted as in Offset(,column) and default 0 for row is implied.
The RC refers to cell position, absolute or relative.
RC in this case is the same cell in another sheet
R2C2 = cell B2
R[2]C = Offset(2,0)
R2C[5] = row 2 offset 5 columns
and so on.

Using the macro recorder will produce

Sub Macro1()
'
' Macro1 Macro
'


'
Range("C3:C22").Select
ActiveCell.FormulaR1C1 = "=SUM(Sheet2:Sheet4!RC)"
Range("C3").Select
End Sub


with a little editing


Sub Macro1()
Range("C3:C22").FormulaR1C1 = "=SUM(Sheet2:Sheet4!RC)"
End Sub

jcrain2v
05-03-2017, 06:43 PM
Sam T i was able to get yours to work, but it looped. Mdmakillup I had trouble getting that last one you sent to work, but I a sure its due to my inexperience. This is what I ended up with.


Sub updatethesum()
Dim ws As Worksheet
Dim i As Double
Dim j, k, l, m As Long

For j = 3 To 44
i = 0
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Total" Then
i = i + ws.Range("c" & j)
End If
Next
Sheets("Total").Range("c" & j) = i
Next j

For k = 3 To 44
i = 0
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Total" Then
i = i + ws.Range("e" & k)
End If
Next
Sheets("Total").Range("e" & k) = i
Next k

For l = 3 To 44
i = 0
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Total" Then
i = i + ws.Range("f" & l)
End If
Next
Sheets("Total").Range("f" & l) = i

Next l

For m = 3 To 44
i = 0
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Total" Then
i = i + ws.Range("g" & m)
End If
Next
Sheets("Total").Range("g" & m) = i

Next m

End Sub

It works exactly as needed. Is there a way to clean it up and still get the same function without looping. I am writing this for the office lady who does the data entry. I need to make sure it'll only calculate once in case the button gets hit more than once.

jcrain2v
05-03-2017, 07:28 PM
I have been working on a financial spread sheet that totals the daily cost for various pieces of equipment on various projects. I with the input of a couple of people in the forum as able to come up with a macro the sums the daily input values for cells in a column. I am new to VBA and am requesting help for writing another macro that will update all current sheets at once. In our case we keep a daily operating cost of all our equipment. Our spreadsheet has a template sheet we copy and rename for each day. If we rent a piece of equipment or get a new machine and we enter it as a line item of the template sheet I would like that input to be transferred to all previous sheets and the totals sheet. Plus is there a way have my range 3 to 44 adjust automatically? If I add 5 pieces of equipment I'd have to adjust the macro to incorporate the 5 new line items. I don't have time to do this all the time as I performing civil engineering (drafting, design, estimating, and surveying) work for a contractor and the office person who uses the spreadsheet has no clue on how to do this stuff. Here is what I have thus far, if you can help me simplify it great!


Sub updatethesum()
Dim ws As Worksheet
Dim i As Double
Dim j, k, l, m As Long

For j = 3 To 44
i = 0
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Total" Then
i = i + ws.Range("c" & j)
End If
Next
Sheets("Total").Range("c" & j) = i
Next j

For k = 3 To 44
i = 0
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Total" Then
i = i + ws.Range("e" & k)
End If
Next
Sheets("Total").Range("e" & k) = i
Next k

For l = 3 To 44
i = 0
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Total" Then
i = i + ws.Range("f" & l)
End If
Next
Sheets("Total").Range("f" & l) = i

Next l

For m = 3 To 44
i = 0
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Total" Then
i = i + ws.Range("g" & m)
End If
Next
Sheets("Total").Range("g" & m) = i

Next m

End Sub

Thanks in advance! Plus now when I think about it I should have known better, once we add it to the template sheet it'll be added every time for future sheets. Typed before I thought!:doh:

SamT
05-03-2017, 08:43 PM
Sub SamT_updatethesum()
Const TotalsRng As String = "C3:G44"

Dim ws As Worksheet
Dim Dest As Range
Set Dest = Sheets("Total").Range(TotalsRng)

For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Total" Then
ws.Range(TotalsRng).Copy
Dest.PasteSpecial Operation:=xlAdd
End If
Next
End Sub



Hmmmn? Column D?

SamT
05-03-2017, 08:50 PM
I need to make sure it'll only calculate once in case the button gets hit more than once.
For how long?
This session of Excel?
Today?
Until Sheet is copied somewhere?
Forever?

What is the State of Sheet:=Total before this Summing?
Might need someplace on the sheet to store the info needed to prevent over stamping.

jcrain2v
05-03-2017, 09:00 PM
I realize this can get super complicated, but right now I am just trying to establish something basic until I can learn more about VBA. I have a button to run the macro I wrote once the data entry has been done. My guess would be this session of excel. Once she copies the template sheet and changes its name she will simply go to the totals sheet and click the button. It seems a straight forward approach, and i fear that If I get it doing too much she may get freaked out.

jcrain2v
05-03-2017, 09:05 PM
is there a way to not limit the cells to rows to 3 to 44. if we have to add additional line items is there a way to get that to change dynmanically. Sorry SamT i am completely new to VBA

jcrain2v
05-03-2017, 09:06 PM
I need column D to remain static.

SamT
05-03-2017, 09:14 PM
As you can/will see, I merged your other thread into this one. We like to keep all posts about the same project in one thread. It's 'cuz we gets confused eezy.

SamT
05-03-2017, 10:08 PM
I realize this can get super complicated, but right now I am just trying to establish something basic until I can learn more about VBA.


performing civil engineering (drafting, design, estimating, and surveying) work


I am new to VBA and am requesting help for writing another macro that will update all current sheets at once. In our case we keep a daily operating cost of all our equipment. Our spreadsheet has a template sheet we copy and rename for each day. If we rent a piece of equipment or get a new machine and we enter it as a line item of the template sheet I would like that input to be transferred to all previous sheets and the totals sheet. Plus is there a way have my range 3 to 44 adjust automatically?
We can handle the D column by either saving it before Summing and replacing it after, or by two copy and paste operations on each ws.

Making the Copy Range dynamic is trivial.

As to adding new line items to all previous sheets, well, we here at VBAX haven't "surveyed" the existing work, yet, have we? Are you sure that the historical data sheets need to be updated with all (future to them) line items?

This is a slightly larger and more complex a project then you are able to see at the moment. Not like skyscraper or strip mall big, but like road side rest stop facilities complex. Can you upload a workbook with the template and Total sheet in it? I am assuming that all other sheets are filled out copies of the Template. BTW, is the template in this same Workbook?

mdmackillop
05-04-2017, 01:16 AM
On the face of it, it looks like you'll end up with dozen's of nearly identical daily sheets. Is there a reason not to have one sheet with variable information under a date heading?
As a surveyor for 40+ years, I'm aware of the detail that gets generated for no good reason (nobody looks at it). It is just necessary to produce it when required, not usually on a daily basis.
Having said that, if you can show us what data you have and what output you need, I'm sure a solution can be found.

Note: "Solved" marker removed

jcrain2v
05-04-2017, 07:24 AM
19081

I'm just basing logic on the fact that if any future line item is added and it adds itself to add previous worksheets as well it'll ensure that the cells that are being summed wont get offset and return false values for example the previous a10 cells get added to all future a11 cells if I insert something between a3 and a10. The range for my summation macro I guess doesn't have to be dynamic. I just want to be able to perform different calculations underneath the table and not sum them. The downfall is if I increase the range (by adding several new pieces of equipment) outside my defined range it wont sum the cells. I suppose I could have column d sum too.

mdmackillop
05-04-2017, 08:56 AM
Here's an approach to consider
All items go on the Equipment page which will update other pages.
Add Sheet will make a copy of Blank and renumber it. Items where there is a non-zero total on the Totals page will be highlighted in Column C
The formula in Total/Hours will automatically sum all sheets from 1 to Blank (this should be kept as a template and could be hidden)

Edit: If you wish daily totals, add the formulae to Row 1 of the Blank sheet; keeps things simple

jcrain2v
05-04-2017, 09:43 AM
I thought about doing something similar to that from the get go, but I wanted to be a little pig headed and try it with macros. That way I could eliminate the formulas in the cells in effort to keep them from accidentally getting changed, but I suppose I could lock them. Also I was trying to avoid the huge range of cells -'s and 0's (which could be altered of course). Is was thinking macros would help prevent some of that and also help me learn more about them so I can start writing macros for other programs for things I would need them to do (such as AutoCAD Civil 3D, Bentley WaterCAD/Hammer, or others). That new page thing is nice, I can add a small macro that that'll change the WS name to the respective date, I'm thinking along the lines of it prompting the user for date input upon hitting the button.

mdmackillop
05-04-2017, 10:27 AM
A revised version to hide the Blank page.
0 and - have been removed using Custom Formatting.
Change this line .Name = CStr(x) to add the date directly or to use an InputBox

jcrain2v
05-04-2017, 10:32 AM
I did and input box, i felt that would be best since 3 or 4 days can go by the DAILY spread sheet is compiled. I didn't think about custom formatting for some reason even though in the past I have used to it to assign units for hydraulic design calculations.

mdmackillop
05-04-2017, 10:49 AM
You could consider automatically creating a sheet for each day (weekday) from the last date entered if that is required.

jcrain2v
05-04-2017, 12:44 PM
mdmackillop. I ended up with this.


Sub AddSheet_Workday()
Dim sh As Worksheet
Dim x As Long
Dim r As Range, cel As Range

x = Sheets("Blank").Index
Sheets("Blank").Copy Before:=Sheets(x)
Set sh = ActiveSheet
sh.Name = InputBox("Date?")

Set r = Sheets("Total").Cells(3, 4).Resize(198)
For Each cel In r
If cel.Value > 0 Then Sheets(x).Cells(cel.Row, 3).Interior.ColorIndex = 6
Next cel
End Sub

I'm thinking though, that it might be beneficial to incorporate the add sheet button to the daily worksheet as well to reduce the number of actions.

mdmackillop
05-04-2017, 01:03 PM
Add it as an ActiveX button on Blank and call the AddSheet macro saved in a standard module.
This will force a fixed format for the date. This removes illegal charactes entered by the user. Adjust as required.

sh.Name = Format(CDate(InputBox("Date?")), "dd_mm_yy")

jcrain2v
05-04-2017, 04:35 PM
This is replacing my Total sheet and giving me an Runtime-time error 9'( if all I have the Blank, Total, and Equipment Worksheet). How about referencing x a equipment and having it place x-2?


Sub AddSheet_Workday()
Dim sh As Worksheet
Dim x As Long
Dim r As Range, cel As Range

With Sheets("Blank")
x = Sheets("Blank").Index
Sheets("Blank").Copy Before:=Sheets(x)
Set sh = ActiveSheet
sh.Name = InputBox("Date?")
End With

Set r = Sheets("Total").Cells(3, 4).Resize(198)
For Each cel In r
If cel.Value > 0 Then Sheets(x).Cells(cel.Row, 3).Interior.ColorIndex = 6
Next cel
End Sub

19088

jcrain2v
05-04-2017, 04:50 PM
The break down is the hidden cell

mdmackillop
05-05-2017, 01:19 AM
The break down is the hidden cell
Hidden cell?

AddSheet code is amended to handle a hidden "Blank" sheet.

Form Buttons have been replaced with ActiveX controls. These are more robust. Form controls with assigned macros can end up pointing to other workbooks when workbook is copied/moved.

Rather than endless looping, I've used Copy/PasteSpecial functionality.

I've added a checking routine (see commented lines). Once you are satisfied totals are correct, these lines can be deleted.


Sub AddSheet_Workday()
Dim sh As Worksheet
Dim x As Long
Dim r As Range, cel As Range
Dim sName As String

sName = Format(CDate(InputBox("Date?", "New sheet date", Date)), "dd_mm_yy")
If sName = "" Then Exit Sub
With Sheets("Blank")
.Visible = True
x = .Index
.Copy Before:=Sheets(x)
Sheets(x).Name = sName
.Visible = False
End With

Set r = Sheets("Total").Cells(3, 4).Resize(198)
For Each cel In r
If cel.Value > 0 Then Sheets(x).Cells(cel.Row, 3).Interior.ColorIndex = 6
Next cel
End Sub

Sub UpdateTheSum()
Dim Tgt As Range
Dim rDaily As String
Dim ws As Worksheet
Dim arr
Dim i As Long, f As Long 'Check

arr = Array("Blank", "Equipment", "Total")
Set Tgt = Sheets("Total").Range("C3")
rDaily = Range("C3:G200").Address

Tgt.Resize(198, 5).ClearContents
Range("M1").Resize(30, 7).ClearContents 'Check

For Each ws In ThisWorkbook.Worksheets
If IsError(Application.Match(ws.Name, arr)) Then
ws.Range(rDaily).Copy
Tgt.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, skipblanks:=False
'Checking code
i = i + 1
Cells(i, 13) = ws.Name
For f = 3 To 7
Cells(i, 11 + f) = Application.Sum(ws.Columns(f))
Next f
For f = 3 To 7
Cells(i + 1, 11 + f).FormulaR1C1 = "=SUM(R1C:R[-1]C)"
Next f
'End of checking code
End If
Next
Application.CutCopyMode = False
Application.Goto Tgt
End Sub

jcrain2v
05-05-2017, 08:24 AM
Awesome mdmackillop! I meant to say hidden "worksheet", not "cell". I need to pay more attention when typing. Other than changing the date format (mm_dd_yy) around I believe this is a solution for now. I need to learn more about ActiveX controls. I've never used them. The check on the totals sheet is a little off and not returning the same totals as the bottom of the daily sheets, I think I can fix that though. That was a great idea on your part to add that and I'll keep it. Now for whatever reason if one may need to look at the daily totals they are right there instead of have to flip through each worksheet.

mdmackillop
05-05-2017, 08:50 AM
Happy to help.

jcrain2v
05-05-2017, 08:55 AM
I'm going to compare that long code I wrote for each column that the smaller one you wrote that condense it. I'm going to look into getting a VBA book for excel to learn more about it, any suggestions? It's entirely different from LISP or Fortran.

mdmackillop
05-05-2017, 08:58 AM
I was playing around with the code and came across a neater way of totalling the pages (courtesy of SNB) which cuts out the Copy/Paste.

Sub UpdateTheSum()
Dim shTot As Worksheet
Dim ws As Worksheet
Dim arr
Dim i As Long, f As Long 'Check

Set shTot = Sheets("Total")
arr = Array("Blank", "Equipment", "Total")
With shTot
.Range("C3:G200").Name = "Tgt"
.Range("Tgt").ClearContents
.Range("M1").Resize(30, 7).ClearContents 'Check
For Each ws In ThisWorkbook.Worksheets
If IsError(Application.Match(ws.Name, arr)) Then
ws.Range("C3:G200").Name = "rData"
[Tgt] = [index(tgt+rdata,)]
'Checking code
i = i + 1
.Cells(i, 13) = ws.Name
For f = 3 To 7
.Cells(i, 11 + f) = Application.Sum(ws.Columns(f))
Next f
.Cells(i + 1, 14).Resize(, 5).FormulaR1C1 = "=SUM(R1C:R[-1]C)"
'End of checking code
End If
Next
End With
End Sub

jcrain2v
05-05-2017, 09:52 AM
Ahh the check you provided adds the sum of all the entries to to each individual entry again in turn doubling it. A cheap work around would be to multiply the sum by .5 in the check.


Sub UpdateTheSum()
Dim shTot As Worksheet
Dim ws As Worksheet
Dim arr
Dim i As Long, f As Long 'Check

Set shTot = Sheets("Total")
arr = Array("Blank", "Equipment", "Total")
With shTot
.Range("C3:G200").Name = "Tgt"
.Range("Tgt").ClearContents
.Range("M1").Resize(30, 7).ClearContents 'Check
For Each ws In ThisWorkbook.Worksheets
If IsError(Application.Match(ws.Name, arr)) Then
ws.Range("C3:G200").Name = "rData"
[Tgt] = [index(tgt+rdata,)]
'Checking code
i = i + 1
.Cells(i, 13) = ws.Name
For f = 3 To 7
.Cells(i, 11 + f) = Application.Sum(ws.Columns(f)) * 0.5
Next f
.Cells(i + 1, 14).Resize(, 5).FormulaR1C1 = "=SUM(R1C:R[-1]C)"
'End of checking code
End If
Next
End With
End Sub

mdmackillop
05-05-2017, 10:11 AM
Are you taking account of the totalling you added in rows 45,46?

jcrain2v
05-05-2017, 10:23 AM
19096row 47 should be the totaling row. since the code accounts for a range up to 200 it'll take the sum of all the rows and add it to itself. One nice thing about multiplying it by .5 is that the rows can change as needed if any rows are inserted (on the equipment sheet and throughout the workbook), it'll return what the actual total would be.

jcrain2v
05-05-2017, 10:46 AM
Now I'd like set up the rest of the workbook to update based on inserting a row on the equipment sheet and having the workbook update. I want to eliminate formulas in the cells as much as possible, i'm honestly getting tired of things in the workbook getting adjusted or changed and having to deal with frustrated attitudes while trying to help them fix. If there is nothing there that can get manipulated out of lack of care or out of ignorance my stress level will go way down (i don't handle that kind of attitude well at all).

mdmackillop
05-05-2017, 10:53 AM
Personally I would not include such totalling/analysis within the data grid. It is prone to such doubling/inclusion errors. I would either resize the grid if appropriate or hide blank rows if you need totals at the bottom of each column. However, using row 1 (or 3,4 by moving the data) or offsetting below the buttons keeps totals visible.
The check, in any case, was intended as a debug exercise, not as an analysis tool.