Dynamic named range generator

DNRvba

#Const LateBind = True
Function RegExpSubstitute(ReplaceIn, _
        ReplaceWhat As String, ReplaceWith As String)
    #If Not LateBind Then
    Dim RE As RegExp
    Set RE = New RegExp
    #Else
    Dim RE As Object
    Set RE = CreateObject("vbscript.regexp")
        #End If
    RE.Pattern = ReplaceWhat
    RE.Global = True
    RegExpSubstitute = RE.Replace(ReplaceIn, ReplaceWith)
    End Function
 
Sub createRanges()
' Specify some upfront variables
rCol = ActiveSheet.UsedRange.Columns(1).Column
rRow = ActiveSheet.UsedRange.Rows(1).Row
sName = "'" & ActiveSheet.Name & "'!"
' This is where the row count gets multiplied to allow for growth
LastRow = (ActiveSheet.UsedRange.Rows.Count - 1) * 10
LastColumn = ActiveSheet.UsedRange.Columns.Count
 
' Build a cleansed sheetname for use in naming the raw data tables
sheetname = ActiveSheet.Name
sheetname = RegExpSubstitute(sheetname, "[^\w+]", "")
sheetname = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(sheetname, "0", "a"), "1", "b"), "2", "c"), "3", "d"), "4", "e"), "5", "f"), "6", "g")
, "7", "h"), "8", "i"), "9", "j"), "|", "")
 
' Build the headered raw data range 
ActiveWorkbook.Names.Add Name:=sheetname, _
        RefersTo:="=Offset(" & sName & Cells(rRow, rCol).Address & ",0,0,counta(" _
        & sName & Cells(rRow, rCol).Address & ":" & Cells(LastRow, rCol).Address _
        & "),counta(" & sName & Cells(rRow, rCol).Address & ":" & Cells(rRow, LastColumn * 3).Address & "))"
 
' Build the headerless raw data range 
ActiveWorkbook.Names.Add Name:=sheetname & "HEADERLESS", _
        RefersTo:="=Offset(" & sName & Cells(rRow + 1, rCol).Address & ",0,0,counta(" _
        & sName & Cells(rRow + 1, rCol).Address & ":" & Cells(LastRow, rCol).Address _
        & "),counta(" & sName & Cells(rRow, rCol).Address & ":" & Cells(rRow, LastColumn * 3).Address & "))"
 
' Create individual columns ranges
While rCol <= LastColumn
rangeName = Replace(Cells(rRow, rCol).Value, " ", "")
rangeName = RegExpSubstitute(rangeName, "[^\w+]", "")
rangeName = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(rangeName, "0", "a"), "1", "b"), "2", "c"), "3", "d"), "4", "e"), "5", "f"), "6", "g")
, "7", "h"), "8", "i"), "9", "j"), "|", "")
ActiveWorkbook.Names.Add Name:=rangeName, _
    RefersTo:="=Offset(" & sName & Cells(rRow + 1, rCol).Address & ",0,0,counta(" & sName & Cells(rRow + 1, ActiveSheet.UsedRange.Columns(1).Column).Address & ":" & Cells(LastRow, ActiveSheet.UsedRange.Columns(1).Column).Address & "))"
rCol = rCol + 1
Wend
 
End Sub