Pseudo Code for this VBA code and its modification

FinPro

New Member
Joined
Jun 4, 2014
Messages
22
Alright, so I basically have two problem in one post:

1. Translating this VBA code. This copies the data of different sheets to one summary sheet.

If Sheet.Name <> Me.Name Then If sheet name
If Sheet.Cells(Rows.Count, 1).End(xlUp).Row <> 1 Then
Sheet.Range(Sheet.Cells(2, 1), Sheet.Cells(Sheet.Cells(Rows.Count, 1).End(xlUp).Row, 10)).Copy Destination:=Me.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

2. My other problem is to modify this code so that I have Sheet Names on First Column of Summary Sheet with "Sum" of three different columns of each sheet against that name. I have 100+ Sheets in the file and will need the summary sheet to automatically adjust for the new sheets inserted. You may suggest an entirely new solution or a modification of this.

I would prefer if I have the control as to when this code is executed and NOT every time summary sheet is activated.

I am using Excel 2007.

Thanks for your help in advance.

FinPro.
 

Some videos you may like

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

FinPro

New Member
Joined
Jun 4, 2014
Messages
22
Just bumping this to bring to notice of our valued members. Appreciate if some one can respond. Thanks.
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
10,880
Office Version
  1. 2019
Platform
  1. Windows
Try this, to avoid data being lost / overwritten, please test on a copy first, not the original file.

Code:
Option Explicit
Sub Copy_To_Summary()
Dim ws as WorkSheet
For Each ws In WorkSheets
    If ws.Name <> "Summary" Then
        ws.Range("A2:J" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Copy Sheets("Summary").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End If
Next
End Sub

Not sure what you're asking for with sheet names inserted in first column, etc. Should this be an extra row immediately above the copied data?
 

FinPro

New Member
Joined
Jun 4, 2014
Messages
22
Thanks jasonb75 and sorry for creating the confusion.

Let me try to rephrase the issue, ignoring the part of "translation".

I have a file with more than hundred sheets. What I am looking for is a code that does the following:

1. Copy the names of each sheet in the file on "Summary" sheet, Column A.
2. Copy the "Sum" of Columns E, F and G of each sheet in "Summary" against the name of the sheet.

So basically Summary sheet will be a list of names of all sheets in the file along with totals of each sheet.

I DO NOT want to copy the data from the sheets.

Thanks.
FinPro
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
10,880
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

2 more things to clarify,

How should the columns be set up in the summary sheet? Sum of E in column B, sum of F in column C and sum of G in column D?

When you re-run the code, should the existing summary totals be overwritten, if not, where should it be added to the sheet?
 

FinPro

New Member
Joined
Jun 4, 2014
Messages
22
thanks for taking the time to study it jasonb75.

The answer to your first question is "Yes". Col E will be in Col B and so on.

The answer to your second question is that existing contents will be overwritten.

Also I would like to have control over the code when it is executed rather than having it run on every time Summary sheet is activated, if possible please.

Regards,
FinPro
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
10,880
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

See if this does what you need.

Code:
Option Explicit
Sub fill_summary()
Dim sFound As Range, ws As Worksheet
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False

With Sheets("Summary")
    For Each ws In Worksheets
        If ws.Name <> .Name Then
            Set sFound = .Range("A:A").Find(ws.Name)
            If sFound Is Nothing Then .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1) = ws.Name
        End If
    Next
    With .Range("B2:D" & .Cells(Rows.Count, 1).End(xlUp).Row)
        .FormulaR1C1 = "=SUM(INDIRECT(""'""&RC1&""'!C[3]:C[3]"",0))"
        Application.Calculate
        '.Value = .Value
    End With
End With

    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
End With
End Sub
 

FinPro

New Member
Joined
Jun 4, 2014
Messages
22
Perfect jasonb75. Its exactly what I was looking for. Thanks a heap.

One last thing, if I want to change the "Source" coulmns i.e E, F and G, is it possible to do it by making some minor changes in your code? If so what I need to change?
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
10,880
Office Version
  1. 2019
Platform
  1. Windows
Only if the new columns are consecutive.

The line
Rich (BB code):
.FormulaR1C1 = "=SUM(INDIRECT(""'""&RC1&""'!C[3]:C[3]"",0))"

Generates a SUM() formula in columns B:D of the summary sheet with the sheetname taken from column A, the column to sum being 3 columns right of the column with the formula, so column B sums column E, D sums G, if you continued across the sheet, a formula in column J would sum column M in the source sheet, etc.

If you changed 3 to 4 in the line shown, B would sum F, D would sum H, J would sum N, etc (4 columns to the right).

Breaking away from that pattern would need different code.

Also, I just noticed that the line
Rich (BB code):
    '.Value = .Value
is still commented out from while I was testing the code, you need to remove the ' from the start of that line for it to work correctly.
 

Watch MrExcel Video

Forum statistics

Threads
1,109,466
Messages
5,528,972
Members
409,848
Latest member
Blomsten
Top