PDA

View Full Version : Any way to apply changes to one excel document to hundreds of excel documents?



MrSteve
12-19-2007, 09:35 AM
Hello

I'm after adding some validation rules to an excel spreadsheet (using "Dependent Dropdowns from a Sorted List")

I would like to apply these changes to every excel spreadsheet we use. There are hundreds of them.

If there any way to apply this changes to every document without having to do it manually?

Thanks :)

Steve

figment
12-19-2007, 09:48 AM
if the changes are exactly the same, then yes, other wise you need some way of knowing what changed to apply to each sheet.

MrSteve
12-19-2007, 09:52 AM
Thanks for your reply.

Yes the changes are the exact same.

Do you know how I would do this?

Thanks

figment
12-19-2007, 09:59 AM
start by recording a macro of the changes you are making. do this by going to the Tools->Macro->Record New Macro once you are recording, then go through the steps to change a sheet. this will generate code for a single sheet. once you have this code you can modify it for multiple sheets.

after that you need to put to gether a list of all the sheets that need changing. you can do this ither in code or manualy ( i sugest with code). once you have the list of sheets, you send them each to the macro you recorded and modifyed.

i can help you with these steps, if you need it.

grichey
12-19-2007, 11:08 AM
figament - are you saying to point to that macro or what? I'm not aware of how you're suggesting.

figment
12-19-2007, 11:26 AM
once you have the recorded macro, you need to modify it so that it can run on any workhseet not that spacific worksheet that you recorded it on. i can help with this.

once you have the modifyed macro, you will need to call it for each sheet you want changed. you can do this manualy, or you can write something to call the new macro for every worksheet. again i can help with the code if you go that route. if you want to wright code to call the macro for every worksheet, then you will need to compile a list of files and sheet names, that need to be modifyed.

so you get something like this

for each worksheet in list
macro(worksheet)
next

grichey
12-19-2007, 11:30 AM
I'm aware of the for each worksheet ... will that work on work books though??
The only way I'm comprehending this is to open -modify - and close all of the workbooks vs a quick shuffle of the worksheets w/in a workbook.

figment
12-19-2007, 11:40 AM
yes you would have to open all the workbooks, but you can let the code do that. rather then manualy oping them all

gwkenny
12-19-2007, 12:00 PM
It's not that bad actually, especially if the change you perform is always of the same nature. Then I'm sure that part can be coded too.

It's best if you all these files in a separate directory and/or the same naming convention. Then as figment said, you can have the code cycle through all the files in a specific directory that meet your naming convention specifications.

Sometimes it's a bear to set some things up, but after you do, they save you a ton of time!!!

g-
gwkenny@yahoo.com
___________________________________
I need holiday money. Got any jobs, big or small, drop me a line! Thanks!

MrSteve
04-09-2008, 07:49 AM
start by recording a macro of the changes you are making. do this by going to the Tools->Macro->Record New Macro once you are recording, then go through the steps to change a sheet. this will generate code for a single sheet. once you have this code you can modify it for multiple sheets.

after that you need to put to gether a list of all the sheets that need changing. you can do this ither in code or manualy ( i sugest with code). once you have the list of sheets, you send them each to the macro you recorded and modifyed.

i can help you with these steps, if you need it.

Hello

Thanks for the replies everyone.

I now have the VBA I would like to apply to a number of spreadsheets.

All the spreadsheets are in one folder. They all have random names. There are thousands of them.

The VBA does not need to be changed for each spreadsheet - it is the same VBA for them all.

Does anyone know, step by step, how I can do this?

Thanks!

figment
04-09-2008, 08:26 AM
so you need to modify all the sheets in the folder or only some of them?

if you are modifying all of them then try this
Sub testing()
Dim location As String
locationg = "XXXX" '<--path to folder containing spread sheets
Dim a As Long
With Application.FileSearch
.LookIn = location
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True
If (.Execute <> 0) Then
For a = 1 To .FoundFiles.Count
If LCase(Right(.FoundFiles.Item(a), 3)) = "xls" Then '<-- change string to extention your looking for
Call usermacro(.FoundFiles.Item(a)) '<-- send file address to custom macro
End If
Next
End If
End With
End Sub

if your not modifying all of them then you need to find a way to distingush the files you wish to change from the files you dont want to change.

MrSteve
04-09-2008, 09:01 AM
Thanks Figment.

So if I understand correctly:

I want to apply this code to every spreadsheet:



Private Sub Workbook_Open()
Dim wbSource As Workbook
Dim wb As Workbook

Set wb = ThisWorkbook
Set wbSource = Workbooks.Open("\\server (file://server/)\keywords.xls")
wb.Activate

ActiveWorkbook.Names.Add Name:="ActionColumn", RefersToR1C1:="=[keywords.xls]Sheet1!C2"
ActiveWorkbook.Names.Add Name:="KeywordColumn", RefersToR1C1:="=[keywords.xls]Sheet1!C1"
ActiveWorkbook.Names.Add Name:="KeywordList", RefersToR1C1:="=[keywords.xls]Sheet1!R2C4:R20C4"
ActiveWorkbook.Names.Add Name:="KeywordStart", RefersToR1C1:="=[keywords.xls]Sheet1!R1C1"

Range("S1").Select
Selection.NumberFormat = "General"
ActiveCell.FormulaR1C1 = "=MAX(C[-18])+1"
ActiveWorkbook.Names.Add Name:="myNamedRange2", RefersTo:="=IF(COUNTA($A2:$A$30)=0,$S$1,$S$2)"
Range("A2:A30").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=myNamedRange2"
.IgnoreBlank = False
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

Range("B2:B30").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="V,S,"
.IgnoreBlank = False
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

Range("C2:C30").Select
ActiveWorkbook.Names.Add Name:="myNamedRange3", RefersTo:="=IF($D1="""",KeywordList,INDEX(KeywordColumn,MATCH($D1,ActionColumn,0)))"
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=myNamedRange3"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

Range("D2:D30").Select
ActiveWorkbook.Names.Add Name:="myNamedRange4", RefersTo:="=OFFSET(KeywordStart,MATCH($C1,KeywordColumn,0)-1,1,COUNTIF(KeywordColumn,$C1),1)"
' ActiveWorkbook.Names.Add Name:="myNamedRange4", RefersTo:="=A1"
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=myNamedRange4"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

End Sub


I should use a macro like this:



Sub testing()
Dim location As String
location = "c:\testing\"
Dim a As Long
With Application.FileSearch
.LookIn = location
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True
If (.Execute <> 0) Then
For a = 1 To .FoundFiles.Count
If LCase(Right(.FoundFiles.Item(a), 3)) = "xls" Then '<-- change string to extention your looking for
Call Workbook_Open(.FoundFiles.Item(a)) '<-- send file address to custom macro
End If
Next
End If
End With
End Sub


So I need to change Workbook_Open() so it accepts a paramater, and make the parameter become the "TheWorkbook" in Workbook_open?

Sorry if I'm being thick...

Thanks

figment
04-09-2008, 10:22 AM
yes that is correct.

i whent through and changed a few things in your code. efectivly select staments are bad, and i pulled them out. i lack a way to test this code, but it should work.

Sub formating()
Dim location As String
location = "c:\testing\"
Dim a As Long
With Application.FileSearch
.LookIn = location
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True
If (.Execute <> 0) Then
For a = 1 To .FoundFiles.Count
If LCase(Right(.FoundFiles.Item(a), 3)) = "xls" Then '<-- change string to extention your looking for
Call Workbook_Open(.FoundFiles.Item(a)) '<-- send file address to custom macro
End If
Next
End If
End With
End Sub

Private Sub Workbook_Open(file_to_open As String)

Dim wb As Workbook
Dim wo As Worksheet
Set wb = Excel.Workbooks.Open(file_to_open, , False)
Set wo = wb.Worksheets("") '<-- need to pick a worksheet to applay changes to
With wb
With .Names
.Add Name:="ActionColumn", RefersToR1C1:="=[keywords.xls]Sheet1!C2"
.Add Name:="KeywordColumn", RefersToR1C1:="=[keywords.xls]Sheet1!C1"
.Add Name:="KeywordList", RefersToR1C1:="=[keywords.xls]Sheet1!R2C4:R20C4"
.Add Name:="KeywordStart", RefersToR1C1:="=[keywords.xls]Sheet1!R1C1"
.Add Name:="myNamedRange2", RefersTo:="=IF(COUNTA($A2:$A$30)=0,$S$1,$S$2)"
.Add Name:="myNamedRange3", RefersTo:="=IF($D1="""",KeywordList,INDEX(KeywordColumn,MATCH($D1,ActionColumn,0)))"
.Add Name:="myNamedRange4", RefersTo:="=OFFSET(KeywordStart,MATCH($C1,KeywordColumn,0)-1,1,COUNTIF(KeywordColumn,$C1),1)"
End With
With .wo.Range("S1")
.NumberFormat = "General"
.FormulaR1C1 = "=MAX(C[-18])+1"
End With
With .wo.Range("A2:A30").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=myNamedRange2"
.IgnoreBlank = False
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
With .wo.Range("B2:B30").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="V,S,"
.IgnoreBlank = False
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
With .wo.Range("C2:C30").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=myNamedRange3"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
With .wo.Range("D2:D30").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=myNamedRange4"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End With
End Sub

one note, you dont define what worksheet you are applying these changes to. you will need to do this for the code to work relyably.

mdmackillop
04-09-2008, 11:00 AM
MyTest will do for one trial. Figments code in post 13 should pass multiple values in similar fashion. I'm getting an error in the final validation which you may need to investigate.


Sub MyTest()
Workbook_Open ("C:\AAA\Test.xls")
End Sub

Private Sub Workbook_Open(WkBook As String)
Dim wbSource As Workbook
Dim wb As Workbook

Set wbSource = Workbooks.Open("C:\AAA\keywords.xls")
Set wb = Workbooks.Open(WkBook)

ActiveWorkbook.Names.Add Name:="ActionColumn", RefersToR1C1:="=[Keywords.xls]Sheet1!C2"
ActiveWorkbook.Names.Add Name:="KeywordColumn", RefersToR1C1:="=[Keywords.xls]Sheet1!C1"
ActiveWorkbook.Names.Add Name:="KeywordList", RefersToR1C1:="=[Keywords.xls]Sheet1!R2C4:R20C4"
ActiveWorkbook.Names.Add Name:="KeywordStart", RefersToR1C1:="=[Keywords.xls]Sheet1!R1C1"

With Sheets(1).Range("S1")
.NumberFormat = "General"
.FormulaR1C1 = "=MAX(C[-18])+1"
End With

ActiveWorkbook.Names.Add Name:="myNamedRange2", RefersTo:="=IF(COUNTA($A2:$A$30)=0,$S$1,$S$2)"
With Sheets(1).Range("A2:A30").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=myNamedRange2"
.IgnoreBlank = False
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

With Sheets(1).Range("B2:B30").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="V,S,"
.IgnoreBlank = False
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

ActiveWorkbook.Names.Add Name:="myNamedRange3", _
RefersTo:="=IF($D1="""",KeywordList,INDEX(KeywordColumn,MATCH($D1,ActionColumn,0)))"
With Sheets(1).Range("C2:C30").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=myNamedRange3"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

ActiveWorkbook.Names.Add Name:="myNamedRange4", _
RefersTo:="=OFFSET(KeywordStart,MATCH($C1,KeywordColumn,0)-1,1,COUNTIF(KeywordColumn,$C1),1)"
With Sheets(1).Range("D2:D30").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=myNamedRange4"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

End Sub

MrSteve
04-10-2008, 02:55 AM
Thanks for the replies everyone. I have tried both your code but it is giving an error unfortunately :(

The error is:

---------------------------
Microsoft Visual Basic
---------------------------
Compile error:
Procedure declaration does not match description of event or procedure having the same name
---------------------------
OK Help
---------------------------

And it highlights the Workbook_Open function.

I'm sorry if I'm being dumb, but I find this stuff tricky.

Another thing: every spreadsheet I am applying the VBA to needs to have the following code added to it:

Private Sub Workbook_Open()
Dim wbSource As Workbook
Dim wb As Workbook
Set wb = ThisWorkbook
Set wbSource = Workbooks.Open("\\server (file://\\server)\keywords.xls")
wb.Activate
End Sub

Basically every spreadsheet needs to have \\server\keywords.xls (file://\\server\keywords.xls) open in the background. Maybe I didn't make that clear in my post.

Thanks everyone for the help and sorry for being thick!

figment
04-10-2008, 10:16 AM
try changing the name of Workbook_Open. you might be using a bane that excel has resurved.

mdmackillop
04-10-2008, 10:38 AM
Is it possible to post youy Keywords workbook. I get errors otherwise in trying to test the code