ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Duplicate a Formula in 1000 Spreadsheets (https://www.excelbanter.com/excel-programming/395133-duplicate-formula-1000-spreadsheets.html)

stratis

Duplicate a Formula in 1000 Spreadsheets
 
I do have 1000 spreadsheets which keep the data in the same structure.
I do have a number of Cells lets say A1,B1,C1,D1, E1 that include some
functions by calculating the same numbers in each spreadhseet
like Average, Sum(A:A), SUmif etc. Is there a way that that I can insert
this formulas into every workbook in the folder without haveing to open it
copy, paste and svae it every time.




Tom Ogilvy

Duplicate a Formula in 1000 Spreadsheets
 
The workbooks would have to be opened, updated and saved, but using a macro
would make it pretty effortless on your part

Sub UpdateBooks()
Dim sPath as String, sName as String
Dim bk as Workbook
sPath = "C:\Myfolder\"
sName = dir(sPath & "*.xls")
do while sName < ""
if lcase(sName) < lcase(thisworkbook.Name) then
set bk = workbooks.Open(sPath & sName)
bk.Worksheets(1).Range("A1").Formula = "=Sum(A2:A10)"
bk.Close SaveChanges:=True
sName = dir()
end if
Loop
End Sub

would be an example.

--
Regards,
Tom Ogilvy


"stratis" wrote:

I do have 1000 spreadsheets which keep the data in the same structure.
I do have a number of Cells lets say A1,B1,C1,D1, E1 that include some
functions by calculating the same numbers in each spreadhseet
like Average, Sum(A:A), SUmif etc. Is there a way that that I can insert
this formulas into every workbook in the folder without haveing to open it
copy, paste and svae it every time.




stratis

Duplicate a Formula in 1000 Spreadsheets
 
Thank Tom
Its very usefull. Howeveer The macro Keeps running without stopping Endless.
Note that since I do not know in each of the worksheets how many rows there
are the Sum furmuls is SUM (E:E) Not SUM(Ex:Ey)
Any ideas?

Ο χρήστης "Tom Ogilvy" *γγραψε:

The workbooks would have to be opened, updated and saved, but using a macro
would make it pretty effortless on your part

Sub UpdateBooks()
Dim sPath as String, sName as String
Dim bk as Workbook
sPath = "C:\Myfolder\"
sName = dir(sPath & "*.xls")
do while sName < ""
if lcase(sName) < lcase(thisworkbook.Name) then
set bk = workbooks.Open(sPath & sName)
bk.Worksheets(1).Range("A1").Formula = "=Sum(A2:A10)"
bk.Close SaveChanges:=True
sName = dir()
end if
Loop
End Sub

would be an example.

--
Regards,
Tom Ogilvy


"stratis" wrote:

I do have 1000 spreadsheets which keep the data in the same structure.
I do have a number of Cells lets say A1,B1,C1,D1, E1 that include some
functions by calculating the same numbers in each spreadhseet
like Average, Sum(A:A), SUmif etc. Is there a way that that I can insert
this formulas into every workbook in the folder without haveing to open it
copy, paste and svae it every time.




Tom Ogilvy

Duplicate a Formula in 1000 Spreadsheets
 
A typo on a last minute change

Sub UpdateBooks()
Dim sPath as String, sName as String
Dim bk as Workbook
sPath = "C:\Myfolder\"

sName = dir(sPath & "*.xls")
do while sName < ""
if lcase(sName) < lcase(thisworkbook.Name) then
set bk = workbooks.Open(sPath & sName)
bk.Worksheets(1).Range("A1").Formula = "=Sum(A2:A10)"
bk.Close SaveChanges:=True
end if
sName = dir()
Loop
End Sub

--
Regards,
Tom Ogilvy


"stratis" wrote:

Thank Tom
Its very usefull. Howeveer The macro Keeps running without stopping Endless.
Note that since I do not know in each of the worksheets how many rows there
are the Sum furmuls is SUM (E:E) Not SUM(Ex:Ey)
Any ideas?

Ο χρήστης "Tom Ogilvy" *γγραψε:

The workbooks would have to be opened, updated and saved, but using a macro
would make it pretty effortless on your part

Sub UpdateBooks()
Dim sPath as String, sName as String
Dim bk as Workbook
sPath = "C:\Myfolder\"
sName = dir(sPath & "*.xls")
do while sName < ""
if lcase(sName) < lcase(thisworkbook.Name) then
set bk = workbooks.Open(sPath & sName)
bk.Worksheets(1).Range("A1").Formula = "=Sum(A2:A10)"
bk.Close SaveChanges:=True
sName = dir()
end if
Loop
End Sub

would be an example.

--
Regards,
Tom Ogilvy


"stratis" wrote:

I do have 1000 spreadsheets which keep the data in the same structure.
I do have a number of Cells lets say A1,B1,C1,D1, E1 that include some
functions by calculating the same numbers in each spreadhseet
like Average, Sum(A:A), SUmif etc. Is there a way that that I can insert
this formulas into every workbook in the folder without haveing to open it
copy, paste and svae it every time.




joel

Duplicate a Formula in 1000 Spreadsheets
 
Complete code

Sub UpdateBooks()
Dim sPath As String, sName As String
Dim bk As Workbook
Dim wb As Workbook
sPath = "C:\temp\test\"
sName = Dir(sPath & "*.xls")

Set wb = ThisWorkbook
RowCount = 1
Do While sName < ""
If LCase(sName) < LCase(ThisWorkbook.Name) Then
Set bk = Workbooks.Open(sPath & sName)

Call addsummary(bk)
bk.Worksheets(1).Range("A1:D1").Copy

wb.Worksheets(1).Activate
Cells(RowCount, "A").Select
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
RowCount = RowCount + 1
bk.Close SaveChanges:=True
sName = Dir()
End If
Loop
End Sub
Sub addsummary(bk As Workbook)

With bk.Worksheets(1)
'testt if summary orw already exists
If .Cells(1, "E") = "Summary" Then

Else


.Cells(1, "A").EntireRow.Insert
.Cells(1, "E") = "Summary"
.Cells(1, "A") = .Cells(3, "A")

Lastrow = .Cells(Rows.Count, "B").End(xlUp).Row
.Cells(1, "B").Formula = "=sum(B3:B" & Lastrow & ")"
.Cells(1, "C").Formula = "=sum(C3:C" & Lastrow & ")"


.Cells(1, "D").Formula = "=SumIf(D3:D" & Lastrow & _
",""Final"", C3:C" & Lastrow & ")"
End If
End With
End Sub


"Tom Ogilvy" wrote:

The workbooks would have to be opened, updated and saved, but using a macro
would make it pretty effortless on your part

Sub UpdateBooks()
Dim sPath as String, sName as String
Dim bk as Workbook
sPath = "C:\Myfolder\"
sName = dir(sPath & "*.xls")
do while sName < ""
if lcase(sName) < lcase(thisworkbook.Name) then
set bk = workbooks.Open(sPath & sName)
bk.Worksheets(1).Range("A1").Formula = "=Sum(A2:A10)"
bk.Close SaveChanges:=True
sName = dir()
end if
Loop
End Sub

would be an example.

--
Regards,
Tom Ogilvy


"stratis" wrote:

I do have 1000 spreadsheets which keep the data in the same structure.
I do have a number of Cells lets say A1,B1,C1,D1, E1 that include some
functions by calculating the same numbers in each spreadhseet
like Average, Sum(A:A), SUmif etc. Is there a way that that I can insert
this formulas into every workbook in the folder without haveing to open it
copy, paste and svae it every time.




stratis

Duplicate a Formula in 1000 Spreadsheets
 
Great almost worked.
One slight problem
The problem is that when I use a formula like sumif(A:A,"Regional",B:B) the
macro is crashing
any ideas

Ο χρήστης "Joel" *γγραψε:

Complete code

Sub UpdateBooks()
Dim sPath As String, sName As String
Dim bk As Workbook
Dim wb As Workbook
sPath = "C:\temp\test\"
sName = Dir(sPath & "*.xls")

Set wb = ThisWorkbook
RowCount = 1
Do While sName < ""
If LCase(sName) < LCase(ThisWorkbook.Name) Then
Set bk = Workbooks.Open(sPath & sName)

Call addsummary(bk)
bk.Worksheets(1).Range("A1:D1").Copy

wb.Worksheets(1).Activate
Cells(RowCount, "A").Select
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
RowCount = RowCount + 1
bk.Close SaveChanges:=True
sName = Dir()
End If
Loop
End Sub
Sub addsummary(bk As Workbook)

With bk.Worksheets(1)
'testt if summary orw already exists
If .Cells(1, "E") = "Summary" Then

Else


.Cells(1, "A").EntireRow.Insert
.Cells(1, "E") = "Summary"
.Cells(1, "A") = .Cells(3, "A")

Lastrow = .Cells(Rows.Count, "B").End(xlUp).Row
.Cells(1, "B").Formula = "=sum(B3:B" & Lastrow & ")"
.Cells(1, "C").Formula = "=sum(C3:C" & Lastrow & ")"


.Cells(1, "D").Formula = "=SumIf(D3:D" & Lastrow & _
",""Final"", C3:C" & Lastrow & ")"
End If
End With
End Sub


"Tom Ogilvy" wrote:

The workbooks would have to be opened, updated and saved, but using a macro
would make it pretty effortless on your part

Sub UpdateBooks()
Dim sPath as String, sName as String
Dim bk as Workbook
sPath = "C:\Myfolder\"
sName = dir(sPath & "*.xls")
do while sName < ""
if lcase(sName) < lcase(thisworkbook.Name) then
set bk = workbooks.Open(sPath & sName)
bk.Worksheets(1).Range("A1").Formula = "=Sum(A2:A10)"
bk.Close SaveChanges:=True
sName = dir()
end if
Loop
End Sub

would be an example.

--
Regards,
Tom Ogilvy


"stratis" wrote:

I do have 1000 spreadsheets which keep the data in the same structure.
I do have a number of Cells lets say A1,B1,C1,D1, E1 that include some
functions by calculating the same numbers in each spreadhseet
like Average, Sum(A:A), SUmif etc. Is there a way that that I can insert
this formulas into every workbook in the folder without haveing to open it
copy, paste and svae it every time.




Tim Williams

Duplicate a Formula in 1000 Spreadsheets
 
Show the exact line(s) of code causing the problem. Remember you need to
double-up quotes if you use them inside a string.

Eg:
..Cells(1, "B").Formula = "=sumif(A:A,""Regional"",B:B)"

Tim


"stratis" wrote in message
...
Great almost worked.
One slight problem
The problem is that when I use a formula like sumif(A:A,"Regional",B:B)
the
macro is crashing
any ideas

? ??????? "Joel" ???????:

Complete code

Sub UpdateBooks()
Dim sPath As String, sName As String
Dim bk As Workbook
Dim wb As Workbook
sPath = "C:\temp\test\"
sName = Dir(sPath & "*.xls")

Set wb = ThisWorkbook
RowCount = 1
Do While sName < ""
If LCase(sName) < LCase(ThisWorkbook.Name) Then
Set bk = Workbooks.Open(sPath & sName)

Call addsummary(bk)
bk.Worksheets(1).Range("A1:D1").Copy

wb.Worksheets(1).Activate
Cells(RowCount, "A").Select
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
RowCount = RowCount + 1
bk.Close SaveChanges:=True
sName = Dir()
End If
Loop
End Sub
Sub addsummary(bk As Workbook)

With bk.Worksheets(1)
'testt if summary orw already exists
If .Cells(1, "E") = "Summary" Then

Else


.Cells(1, "A").EntireRow.Insert
.Cells(1, "E") = "Summary"
.Cells(1, "A") = .Cells(3, "A")

Lastrow = .Cells(Rows.Count, "B").End(xlUp).Row
.Cells(1, "B").Formula = "=sum(B3:B" & Lastrow & ")"
.Cells(1, "C").Formula = "=sum(C3:C" & Lastrow & ")"


.Cells(1, "D").Formula = "=SumIf(D3:D" & Lastrow & _
",""Final"", C3:C" & Lastrow & ")"
End If
End With
End Sub


"Tom Ogilvy" wrote:

The workbooks would have to be opened, updated and saved, but using a
macro
would make it pretty effortless on your part

Sub UpdateBooks()
Dim sPath as String, sName as String
Dim bk as Workbook
sPath = "C:\Myfolder\"
sName = dir(sPath & "*.xls")
do while sName < ""
if lcase(sName) < lcase(thisworkbook.Name) then
set bk = workbooks.Open(sPath & sName)
bk.Worksheets(1).Range("A1").Formula = "=Sum(A2:A10)"
bk.Close SaveChanges:=True
sName = dir()
end if
Loop
End Sub

would be an example.

--
Regards,
Tom Ogilvy


"stratis" wrote:

I do have 1000 spreadsheets which keep the data in the same
structure.
I do have a number of Cells lets say A1,B1,C1,D1, E1 that include
some
functions by calculating the same numbers in each spreadhseet
like Average, Sum(A:A), SUmif etc. Is there a way that that I can
insert
this formulas into every workbook in the folder without haveing to
open it
copy, paste and svae it every time.






joel

Duplicate a Formula in 1000 Spreadsheets
 
Look at my syntax for similar statement

..Cells(1, "D").Formula = "=SumIf(D3:D" & Lastrow & _
",""Final"", C3:C" & Lastrow & ")"

Your should be something like this
..Cells(1, "D").Formula = "=sumif(A:A,""Regional"",B:B)"

the double quotes are needed so that VBA replaces it with a single quote

"stratis" wrote:

Great almost worked.
One slight problem
The problem is that when I use a formula like sumif(A:A,"Regional",B:B) the
macro is crashing
any ideas

Ο χρήστης "Joel" *γγραψε:

Complete code

Sub UpdateBooks()
Dim sPath As String, sName As String
Dim bk As Workbook
Dim wb As Workbook
sPath = "C:\temp\test\"
sName = Dir(sPath & "*.xls")

Set wb = ThisWorkbook
RowCount = 1
Do While sName < ""
If LCase(sName) < LCase(ThisWorkbook.Name) Then
Set bk = Workbooks.Open(sPath & sName)

Call addsummary(bk)
bk.Worksheets(1).Range("A1:D1").Copy

wb.Worksheets(1).Activate
Cells(RowCount, "A").Select
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
RowCount = RowCount + 1
bk.Close SaveChanges:=True
sName = Dir()
End If
Loop
End Sub
Sub addsummary(bk As Workbook)

With bk.Worksheets(1)
'testt if summary orw already exists
If .Cells(1, "E") = "Summary" Then

Else


.Cells(1, "A").EntireRow.Insert
.Cells(1, "E") = "Summary"
.Cells(1, "A") = .Cells(3, "A")

Lastrow = .Cells(Rows.Count, "B").End(xlUp).Row
.Cells(1, "B").Formula = "=sum(B3:B" & Lastrow & ")"
.Cells(1, "C").Formula = "=sum(C3:C" & Lastrow & ")"


.Cells(1, "D").Formula = "=SumIf(D3:D" & Lastrow & _
",""Final"", C3:C" & Lastrow & ")"
End If
End With
End Sub


"Tom Ogilvy" wrote:

The workbooks would have to be opened, updated and saved, but using a macro
would make it pretty effortless on your part

Sub UpdateBooks()
Dim sPath as String, sName as String
Dim bk as Workbook
sPath = "C:\Myfolder\"
sName = dir(sPath & "*.xls")
do while sName < ""
if lcase(sName) < lcase(thisworkbook.Name) then
set bk = workbooks.Open(sPath & sName)
bk.Worksheets(1).Range("A1").Formula = "=Sum(A2:A10)"
bk.Close SaveChanges:=True
sName = dir()
end if
Loop
End Sub

would be an example.

--
Regards,
Tom Ogilvy


"stratis" wrote:

I do have 1000 spreadsheets which keep the data in the same structure.
I do have a number of Cells lets say A1,B1,C1,D1, E1 that include some
functions by calculating the same numbers in each spreadhseet
like Average, Sum(A:A), SUmif etc. Is there a way that that I can insert
this formulas into every workbook in the folder without haveing to open it
copy, paste and svae it every time.





All times are GMT +1. The time now is 05:27 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com