Add Named Ranges To Multiple Workbooks Using VBA

[Stalker]

Good morning Happy Campers,

I have timesheets in work, where i created basic formulas to display times & worked hours etc.
I also have named ranges on 4 of the sheet.

The sheets are named as the department (area 1, stock control etc.)
All the sheets are identical in terms of layout, only the names of staff and hours worked are different.

When i created them, i tried to be pro-active and created flippin loads, through to October this year lol.
Problem being i created a Summary sheet for each workbook, which in short takes all names from all areas and collates them on the last tab, puts Mon-Sun across the top, enters the hours into the relevant days, merges hours worked in different areas and also splits the hours worked over each day.

Everything is working flawlessy.

Except, the above evolution of the sheet was done after i mass created the timesheet, and as such i need to manually open each sheet, set the ranges and name them, add a summary sheet, add the macro, save and close.
So, my request is this:

Is it possible to create a macro on book1, that when i open however many other workbooks (the actual timesheets) the code woould set and name the ranges for me?
The time sheets are all named according to the week -> 'W.C - 08.04.2013', 'W.C - 15.04.2013' etc.

I would be incredibly greatful if its possible!
Stalker

[Rick Rothstein]

I am not sure I followed everything about your setup correctly, but it sounds like you have a workbook for each month. If that is correct, you should create a "template" and use that for each new month as needed. Here is my thinking... set up one workbook exactly like you want, but do not hard code the dates (which seem to be the only thing in the structure of each sheet that varies from workbook to workbook), rather, designate a cell for the month and the cell next to it for the year, then calculate that month's date using formulas. Create all your sheets using these formulas, fill in the names for the various departments, create your summary sheet and add your macros... now save the workbook as a Template file (extension xlt). Now, when you need a new copy of the workbook, don't pick new, choose to open your Template instead (exactly how varies by version, so you will need to tell us your Excel version if you cannot figure it out for yourself)... everything you setup originally will be in place and all you will need to do is enter the month and year into the cell you designated.

[Stalker]

Hi Rick,

Thanks for the feedback.
The workbooks i use are done weekly, with the week commencing date always being the monday, i have created almost the entire years worth of sheets so would like to avoid re doing them all.
I guess i would like a macro that will look at the active workbook and name the ranges i need.

For any new sheets created i am using a template method, and copy->pasting the sheet, changing the name and job done.

[Stalker]

Politely bumped

[Excel Fox]

Stalker, this isn't very specific to what you've asked, but I am mostly certain that this can do the trick. If you can get the way this works, it should be a straightforward thing to do. Check the macro. You can modify it to suit your need. If you think it will suit your purpose, you can download the file.


Option Explicit

Sub AddCusNames()

'Adds all listed names from this workbook to other workbooks
Dim nm As Name
Dim lng As Long
Dim lngList As Long
Dim var As Variant
var = ThisWorkbook.Sheets(1).ListBoxes("lstWorkBooks").List
For lngList = LBound(var) To UBound(var)
If ThisWorkbook.Sheets(1).ListBoxes("lstWorkBooks").Selected(lngList) Then
With ThisWorkbook.Sheets(1)
For lng = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(lng, 4).Value = "Worksheet" Then
Call Application.Workbooks(var(lngList)).Worksheets(.Ce lls(lng, 3).Value).Names.Add(.Cells(lng, 1).Value, .Cells(lng, 2).Value)
Else
Call Application.Workbooks(var(lngList)).Names.Add(.Cel ls(lng, 1).Value, .Cells(lng, 2).Value)
End If
Next lng
End With
End If
Next lngList

End Sub

Sub GetWbks()

'Get a list of ALL open workbooks
Dim wbk As Workbook
With ThisWorkbook.Sheets(1).ListBoxes("lstWorkBooks")
.RemoveAllItems
For Each wbk In Application.Workbooks
If (wbk.Name <> ThisWorkbook.Name) And (Not wbk.IsAddin) And (wbk.Path <> Application.StartupPath) Then
.AddItem wbk.Name
End If
Next wbk
End With

End Sub

Sub GetNms()

'Get the names of all named ranges in any selected workbook
Dim nm As Name
Dim wbk As Workbook
Dim var As Variant
Dim lng As Long

On Error GoTo eRRh
Set wbk = Workbooks.Open(Application.GetOpenFilename("*.xl*", , "Select File", , False), False, True)
ReDim var(1 To ThisWorkbook.Names.Count, 1 To 4)
For Each nm In ThisWorkbook.Names
lng = lng + 1
If InStr(1, nm.Name, "!") Then
var(lng, 1) = Split(nm.Name, "!")(1)
Else
var(lng, 1) = nm.Name
End If
var(lng, 2) = "'" & nm.RefersTo
If nm.Parent.Name = ThisWorkbook.Name Then
var(lng, 3) = nm.RefersToRange.Parent.Name
var(lng, 4) = "Workbook"
Else
var(lng, 3) = nm.Parent.Name
var(lng, 4) = "Worksheet"
End If
Next nm
ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp)(2).Resize(UBound(var), 4).Value = var
wbk.Close 0
Exit Sub
eRRh: MsgBox "Unexpected Error!", vbExclamation, ""

End Sub



You can even manually update the list of names in the sheet (be sure you are 100% accurate in filling at the four properties of the named range, including taking care of the apostrophes (') )

[Stalker]

Good morning and thanks for the response.

May take a while to get my head round it though, i have experience with VBA but not at the length conatined above :D
But none the less i will give it a shot, thanks again