Excel VBA: Active Selection as a Named Range for Pivot Table Data Source

Question

I am trying to turn the current active selection into a named ranged that I can reference as the data source for a pivot table. My function selectByUsedRows provides a selection based on how many rows are in the usedCol and starting and stoping at selectStartCol and selectEndCol. This is usefull when you only want your selection to contain cells that match the amount of rows of a column that is outside the selection. I am out of my depth on naming the selection on this one. Any help would be great.

Excel Data

     A        B         C
1    CaseNum  Branch    Name
2    1234     APL       George
3    2345     VMI       George
4    3456     TEX       Tom
5    4567     NYC       Tom
6    5678     VMI       Sam
7    6789     TEX       Tom
8    7890     NYC       George

VBA

'Check reference column and select the same number of rows in start and end columns
Sub selectByUsedRows(usedCol As String, selectStartCol As String, selectEndCol As String)
n = Range(usedCol & "1").End(xlDown).Row
Range(selectStartCol & "1:" & selectEndCol & n).Select
End Sub

'Dynamically select columns A to C with as many rows as are in A
Sub test()
refCol = "A"
selectStartCol = "A"
selectEndCol = "C"
selectByUsedRows refCol, selectStartCol, selectEndCol

'Code works until this point. There is now an active selection of A1:C8. 
'The following is hypothetical

Dim rngSelection As Range
Set rngSelection = ActiveSelection
Range(rngSourceData).CurrentRegion.Name = "rngSourceData"

Set objTable = Sheet5.PivotTableWizard

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    rngSourceData, Version:=xlPivotTableVersion14).CreatePivotTable _
    TableDestination:="Sheet5!R1C4", TableName:="PivotTable1", DefaultVersion _
    :=xlPivotTableVersion14
End Sub

Answer 1

I think you should consider creating a dynamic range, rather than a static one. A static range like A1:C8 will populate your pivot table just fine until someone enters more data in RefColumn. If you create a dynamic range like

=$A$1:INDEX($C:$C,COUNTA($A:$A),1)

Then you won't have to create the pivot table every time the range changes.

Sub MakePT()

    Dim sh As Worksheet
    Dim pc As PivotCache
    Dim pt As PivotTable
    Dim rUsed As Range

    'Make a dynamic range name and return a reference to it
    Set rUsed = MakeNamedRange(Sheet1, 1, 1, 3, "rngSourceData")

    'Add a new sheet for the pivot table
    Set sh = ThisWorkbook.Worksheets.Add

    'Create a blank pivot table on the new sheet
    Set pc = ThisWorkbook.PivotCaches.Add(xlDatabase, rUsed)
    Set pt = pc.CreatePivotTable(sh.Range("A3"), "MyPivot")


End Sub

Public Function MakeNamedRange(sh As Worksheet, lRefCol As Long, lStartCol As Long, lEndCol As Long, sName As String) As Range

    Dim sRefersTo As String
    Dim nm As Name

    'Comments refer to lRefCol = 1, lStartCol = 1, lEndCol = 3

    '=$A$2:
    sRefersTo = "=" & sh.Cells(1, lStartCol).Address(True, True) & ":"

    '=$A$2:INDEX($C:$C,
    sRefersTo = sRefersTo & "INDEX(" & sh.Cells(1, lEndCol).EntireColumn.Address(True, True) & ","

    '=$A$2:INDEX($C:$C,COUNTA($A:$A),1)
    sRefersTo = sRefersTo & "COUNTA(" & sh.Cells(1, lRefCol).EntireColumn.Address(True, True) & "),1)"

    Set nm = ThisWorkbook.Names.Add(sName, sRefersTo)

    Set MakeNamedRange = sh.Range(sName)

End Function

Answer 2

I'm assuming your struggling to get the pivot table working based on 'code works until this point'

the following prompts for an input range and then provides a basic pivot table outline on a new sheet

Option Explicit

Private Sub someControlOrEvent_Click()
Dim rRange As Range
Dim pTable As Worksheet

    On Error Resume Next
    Set rRange = Application.InputBox(prompt:= _
    "Please select a new data range to name", _
        Title:="SPECIFY RANGE", Type:=8)
    On Error GoTo 0

    If rRange Is Nothing Then
        Exit Sub
    Else

    'Define Named Range (but not used any further)
     ThisWorkbook.Names.Add Name:="MyRange", RefersTo:=rRange


        Set pTable = ThisWorkbook.Sheets.Add

        ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
            rRange, Version:=xlPivotTableVersion14).CreatePivotTable _
            TableDestination:=pTable.Range("A1"), TableName:="PivotTable1", DefaultVersion _
            :=xlPivotTableVersion14
        End If

End Sub

In this case rRange is any range you want, a prompt as in this example or could be a named range, current selection etc. It also assume the pivot table starts in cell A1 of a new sheet.