create multiple dynamic named ranges using vba

[palaeontology]

Hi all,

I know how to make dynamic named ranges using the ws ribbon functions 'Formulas' and 'Define Name', however I have a large number of spreadsheet, and each spreadsheet will need a large number of dynamic named ranges.

My VBA coding is poor, at best, so I'm wondering if it's possible to have code create these numerous dynamic named ranges automatically.

The coding would only need to look at the ws called .... Entry

The 'Entry' ws might look something like this ...

In the image above, there is a maths class that goes by the code .... 10MAA501 ... there are other classes in this Entry ws, for example 10MAA502, 10MAA503, 10MAA601, 10MAA602, 10MAA701, 10MAA702 etc etc etc

From time to time, new students will be added to some of the classes, so I need some code to create a dynamic named range for each class in the list.

So for example, the 10MAA501 range of data currently spans the range .... Entry!A8:AH34 .... and the 10MAA502 range of data currently spans the range .... Entry!A35:AH60 but when new students are added, the ws is re-sorted by column C, so the range for a class would change to something else, for example, 10MAA501 might change to Entry!A8:AH37, and 10MAA502 might change to Entry!A38:AH67.

Is VBA able to create dynamic named ranges or will I need to do each one by hand .... a task I'm not looking forward to and would need to redo for each of 23 workbooks every 6 months.

Kind regards,

Chris

 

[Akuini]

Try this:
It won't create a dynamic range but it will redefine the range of each named range.
I assumed Data is in col A:AH, start at row 8.
When you finish adding the class code (in col C), sort the data by col C, then run this code. It will create/recreate the named range, the range of each named range will change accordingly.

Sub a1117315a()
'https://www.mrexcel.com/board/threads/create-multiple-dynamic-named-ranges-using-vba.1117315/

Dim i As Long, j As Long
Dim va

va = Range("C1", Cells(Rows.count, "C").End(xlUp))
For i = 8 To UBound(va, 1)
    j = i
    Do
        i = i + 1
        If i > UBound(va, 1) Then Exit Do
    Loop While va(i, 1) = va(i - 1, 1)
    i = i - 1
    ActiveWorkbook.names.Add Name:=va(i, 1), RefersTo:=Range(Cells(j, "A"), Cells(i, "AH"))

Next

End Sub

 

[palaeontology]

Hi Akuini, thankyou, so much, for putting that together for me, but I'm getting the following error message ... Run-time error '1004' : Application-defined or object-defined error

It's not highlighting any particular part of your code, so I'm not sure what I'm doing wrong.

Since trying your code, I made the first 3 dynamic named ranges manually and recorded the code needed ....

Sub Dynamic_10MAA501()
    Range("A6").Select
    ActiveWorkbook.Worksheets("Sheet1").Names.Add Name:="Dynamic_10MAA501", _
        RefersToR1C1:="=OFFSET(Sheet1!R6C1,1,0,COUNTIF(Sheet1!C3,""10MAA501""),34)"    'the named range will refer to columns starting at column A and finishing at column AH, and will refer to as many rows (starting at row 7) as relate to 10MAA501 (as found in column C)'
    ActiveWorkbook.Worksheets("Sheet1").Names("Dynamic_10MAA501").Comment = ""
    ActiveWorkbook.Worksheets("Sheet1").Names.Add Name:="Dynamic_10MAA502", _
        RefersToR1C1:= _
        "=OFFSET(Sheet1!R6C1,COUNTIF(Sheet1!C3,""10MAA501"")+1,0,COUNTIF(Sheet1!C3,""10MAA502""),34)"    'the named range will refer to columns starting at column A and finishing at column AH, and will refer to as many rows (starting at the row immediately after 10MAA501) as relate to 10MAA502 (as found in column C)'
    ActiveWorkbook.Worksheets("Sheet1").Names("Dynamic_10MAA502").Comment = ""
    ActiveWorkbook.Worksheets("Sheet1").Names.Add Name:="Dynamic_10MAA503", _
        RefersToR1C1:= _
        "=OFFSET(Sheet1!R6C1,COUNTIF(Sheet1!C3,""10MAA501"")+COUNTIF(Sheet1!C3,""10MAA502"")+1,0,COUNTIF(Sheet1!C3,""10MAA503""),34)"    'the named range will refer to columns starting at column A and finishing at column AH, and will refer to as many rows (starting at the row immediately after 10MAA502) as relate to 10MAA503 (as found in column C)'
    ActiveWorkbook.Worksheets("Sheet1").Names("Dynamic_10MAA503").Comment = ""
    ActiveWindow.SmallScroll Down:=-20
End Sub

As you can see, each new dynamic range requires knowing what row the previous dynamic range finished on, then beginning on the very next row.

The Math class codes won't always be 10MAA501 followed by 10MAA502, etc etc etc. Each 6 months they will be a different set of codes.

Is there a way to shortcut the length and complexity of my code, so I'm not having to go into each one and making the first of the countifs longer and longer each time ?

Kind regards,

Chris

 

[Akuini]

Ah, sorry, I didn't use your class code when testing the the code.
First, replace this line:
ActiveWorkbook.names.Add Name:=va(i, 1), RefersTo:=Range(Cells(j, "A"), Cells(i, "AH"))
with this:
ActiveWorkbook.names.Add Name:="Dynamic_" & va(i, 1), RefersTo:=Range(Cells(j, "A"), Cells(i, "AH"))

And if your data start at row 7 then :
Replace this line:
For i = 8 To UBound(va, 1)
with this:
For i = 7 To UBound(va, 1)

And let's try on a simple data below.

Book1
	A	B	C
7			10MAA501
8			10MAA501
9			10MAA501
10			10MAA503
11			10MAA503
12			10MAA503
13			10MAA503
14			10MAA503
15			10MAA503
16			10MAA504
17			10MAA504
18			10MAA504
Sheet1

Run the code on the example data, see in Name Manager, it will create the named ranges.

Then try adding some data in col C, sort the data, then run the code again. See the changes in the Name Manager.

 

[palaeontology]

That worked brilliantly Akuini, thank you so very much.

My vba is very poor, so I'll now try to understand each line of your code so I can learn from this.

Thank you, so much, again, I really am appreciative of this.

Very kind regards,

Chris

 

[Akuini]

You're welcome, glad to help, & thanks for the feedback.