Repeat the same calculation in multiple sheets

Question

Task: Repeat an identical calculation in multiple sheets.

Background:

multiple sheets labelled by calendar date i.e. 01 04, 02 04, 03 04. These are three discrete sheet names meaning 1st April, 2nd April and 3 April. (actual workbook has all the days in the month).
Data has identical column headings, but the number of rows vary. In brief the data is a list of mastercard and visa transactions.
I want to get the total of column G (happens to contain the monetary transaction value) and only take the Visa transactions.

Result:

the code below does this fine and places the results on the same sheet merely offset by a few columns to the right hand side and highlights the value I need in red. (this is a recorded macro I completed)

Limitation and seeking advise:

1) improve code to repeat this for all sheets by a single click of a mouse button. (as you will note, its about how to cycle through all the sheets within the same workbook rather than (at present) having to manually go into each sheet and run the macro.

thank you in advance

code is:

Sub sum_visa_trans_together()
'
' sum_visa_trans_together Macro
'
' Keyboard Shortcut: Ctrl+r
'
ActiveCell.Rows("1:1").EntireRow.Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$M$14").AutoFilter Field:=2, Criteria1:="V"
ActiveCell.Offset(0, 6).Columns("A:A").EntireColumn.Select
Selection.Copy
ActiveCell.Offset(0, 4).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.AutoFilter
ActiveCell.Offset(0, 11).Range("A1").Select
ActiveCell.FormulaR1C1 = "max"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=MAX(C[-1])"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=SUM(C[-1])"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "visa trans"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=R[-2]C-R[-3]C"
ActiveCell.Select
With Selection.Font
    .Color = -16776961
    .TintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

does the macro as it stands work on all sheets without changes? if so create a new sub procedure that loops through all sheets and calls the macro above — Sorceri, Dec 13 '13 at 16:29

score 0 · Answer 1 · answered Dec 13 '13 at 16:28

this wont repeat in the sheets you want because you are using active cell, you can replace active cell with something like this:

sheetname.cells(1,1).value

in this case you are geting the value of cell A1 wich is row=1,column=1 in the sheet named sheetname

the name of your sheet is not necesary the same in vba so chek your narmes in the vba project explorer.

for example you can try something like this(Im not sure exactly what you are trying to do but this will guide you):

Sub s()

For Each ws In Worksheets 'WS will loop trough all worksheets

Dim TargetCell As Range
Set TargetCell = ws.Cells(1, 2) ' in this case you will run this macro in
                            ' the cell A2 of all your sheets

TargetCell.Rows("1:1").EntireRow.Select
Selection.AutoFilter
ws.Range("$A$1:$M$14").AutoFilter Field:=2, Criteria1:="V"
TargetCell.Offset(0, 6).Columns("A:A").EntireColumn.Select
Selection.Copy
TargetCell.Offset(0, 4).Range("A1").Select
ws.Paste
TargetCell.Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.AutoFilter
TargetCell.Offset(0, 11).Range("A1").Select
TargetCell.FormulaR1C1 = "max"
TargetCell.Offset(1, 0).Range("A1").Select
TargetCell.FormulaR1C1 = "=MAX(C[-1])"
TargetCell.Offset(1, 0).Range("A1").Select
TargetCell.FormulaR1C1 = "=SUM(C[-1])"
TargetCell.Offset(1, 0).Range("A1").Select
TargetCell.FormulaR1C1 = "visa trans"
TargetCell.Offset(1, 0).Range("A1").Select
TargetCell.FormulaR1C1 = "=R[-2]C-R[-3]C"
TargetCell.Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Next
End Sub

[INTERESTING READ](http://stackoverflow.com/questions/10714251/excel-macro-avoiding-using-select) — Siddharth Rout, Dec 13 '13 at 16:32
user2864030: thank you for the advise and link to the MS site. very useful and works. Now trying to understand how it works. However, at the moment it performs the action required. (But I have to continue pressing the "ok" to the dialog box until it completes all sheets (30 clicks)) But its certainly faster than previously. thank you very much — user3047291, Dec 16 '13 at 17:44
bto.rdz. thank you also for taking the time to advise on the above. However I failed to get the code working, although i have noted the active cell issue as you highlighted (with it replaced with target cell). However code failed to execute. Even when in debug mode and stepping into the code. it failed at the Selection.AutoFilter (line 10). If you could advise a novice like me that would be greatly appreciated. thanks, — user3047291, Dec 16 '13 at 17:46
Update: it turns out the code has failed to return the expected answers (upon validation of results). The code I have is - as above and the error observed is "object required" and points to [Set TargetCell = ws.Cells(1, 2)] in the declarations of the code. I have googled and corrective action is to apply [....= ws.Range(ws.Cells(2, i), ws.Cells(lastRow, i))] according to http://stackoverflow.com/questions/16317227/unexpected-error-when-activeworksheet-not-source-worksheet. However this too fails. Please advise how to correct. — user3047291, Dec 16 '13 at 18:55

score 0 · Answer 2 · answered Dec 13 '13 at 16:58

Otherwise:

      Sub WorksheetLoop()

     Dim WS_Count As Integer
     Dim I As Integer

     ' Set WS_Count equal to the number of worksheets in the active
     ' workbook.
     WS_Count = ActiveWorkbook.Worksheets.Count

     ' Begin the loop.
     For I = 1 To WS_Count

        ' Insert your code here.
        ' The following line shows how to reference a sheet within
        ' the loop by displaying the worksheet name in a dialog box.
        MsgBox ActiveWorkbook.Worksheets(I).Name

     Next I

  End Sub

source: http://support.microsoft.com/kb/142126/en

Repeat the same calculation in multiple sheets

2 Answers2