Create a Custom Pivot Table in Excel

What This VBA Code Does: Create a Custom Pivot Table in Excel

This Excel VBA macro, named CreatePivotTableWithFieldSelectionassigned to button ‘Create Pivot Table’, allows users to create a Pivot Table dynamically by selecting the fields they want to use — all through simple pop-up prompts. It’s designed to work on the active worksheet and turns your table of data (starting in cell A1) into a summarized Pivot Table starting at cell I6.

First 4 rows of table

Filename: sample-data-10mins.xlsm

Fields: Sales Person | Country | Product | Date | Amount | Boxes Shipped | Month

Step-by-Step Breakdown

1. Identifies the Data Table
   The code selects the full table of data starting at cell A1, using Excel’s CurrentRegion to automatically detect the data range.
2. Extracts Column Headers
   It pulls the headers (from the first row) to use as options for the Pivot Table setup.
3. User Input: Row & Column Fields
   A prompt appears asking the user to type in two field names (e.g., Country, Product) — one will be the row field, the other the column field.
   If the input is invalid (missing or incorrect headers), the user is asked again.
4. User Input: Data Fields
   A second prompt asks for one or more fields to summarize (e.g., Amount, Boxes Shipped).
   The macro checks each input against the header list to ensure it’s valid.
5. Confirmation Dialog
   Before building the Pivot Table, the user is shown a summary of their selections and asked to confirm.
6. Creates the Pivot Table
   Any existing Pivot Table named "SalesPivot" is cleared.
   A new Pivot Table is created starting at cell I6 using the selected fields:
   • Row Field
   • Column Field
   • Data Field(s) (summarized using Sum by default)
7. Displays a Success Message
   After creation, a message box shows the fields used to confirm the Pivot Table was successfully created.

✅ Example Use Case

Let’s say you have this table:

You could enter:

• Row Field: Country
• Column Field: Product
• Data Fields: Amount, Boxes Shipped

And the macro will automatically create a Pivot Table that shows the sum of Amount and Boxes Shipped for each Country/Product combo.

VBA Macro Code

Sub CreatePivotTableWithFieldSelection()
Dim ws As Worksheet
Dim dataRange As Range
Dim pivotTable As pivotTable
Dim pivotCache As pivotCache
Dim pivotStartCell As Range
Dim headers() As String
Dim headerList As String
Dim inputStr As String
Dim rowField As String, colField As String
Dim dataFieldsInput As String, dataFields() As String
Dim i As Integer
Dim parts() As String
Dim field As Variant

‘ Set worksheet
Set ws = ActiveSheet

‘ Define data range
Set dataRange = ws.Range(“A1”).CurrentRegion

‘ Get headers from first row
ReDim headers(1 To dataRange.Columns.Count)
For i = 1 To dataRange.Columns.Count
headers(i) = dataRange.Cells(1, i).Value
Next i

headerList = Join(headers, “, “)

‘ === Prompt for Row and Column Fields ===
Do
inputStr = InputBox(“Available Fields:” & vbNewLine & headerList & vbNewLine & vbNewLine & _
“Enter Row Field and Column Field separated by a comma (e.g., Country, Product):”, _
“Select Row and Column Fields”)

If inputStr = “” Then Exit Sub

parts = Split(inputStr, “,”)

If UBound(parts) = 1 Then
rowField = Trim(parts(0))
colField = Trim(parts(1))
If Not IsError(Application.Match(rowField, headers, 0)) And _
Not IsError(Application.Match(colField, headers, 0)) Then
Exit Do
End If
End If

MsgBox “Invalid input. Please enter exactly two valid column headers separated by a comma.”, vbExclamation
Loop

‘ === Prompt for Data Fields (Supports Multiple) ===
Do
dataFieldsInput = InputBox(“Available Fields:” & vbNewLine & headerList & vbNewLine & vbNewLine & _
“Enter one or more Data Fields separated by commas (e.g., Amount, Boxes Shipped):”, _
“Select Data Fields”)

If dataFieldsInput = “” Then Exit Sub

dataFields = Split(dataFieldsInput, “,”)
For i = LBound(dataFields) To UBound(dataFields)
dataFields(i) = Trim(dataFields(i))
If IsError(Application.Match(dataFields(i), headers, 0)) Then
MsgBox “Invalid data field: ‘” & dataFields(i) & “‘. Please try again.”, vbExclamation
GoTo RepeatDataFieldInput
End If
Next i
Exit Do
RepeatDataFieldInput:
Loop

‘ === Confirm Selections ===
If MsgBox(“Row Field: ” & rowField & vbNewLine & _
“Column Field: ” & colField & vbNewLine & _
“Data Field(s): ” & Join(dataFields, “, “) & vbNewLine & vbNewLine & _
“Continue to create Pivot Table?”, vbOKCancel + vbQuestion) = vbCancel Then Exit Sub

‘ Set starting cell
Set pivotStartCell = ws.Range(“I6”)

‘ Clear existing pivot table if any
On Error Resume Next
ws.PivotTables(“SalesPivot”).TableRange2.Clear
On Error GoTo 0

‘ Create pivot cache
Set pivotCache = ThisWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=dataRange)

‘ Create pivot table
Set pivotTable = pivotCache.CreatePivotTable( _
TableDestination:=pivotStartCell, _
TableName:=”SalesPivot”)

‘ Set row and column fields
With pivotTable
.PivotFields(rowField).Orientation = xlRowField
.PivotFields(rowField).Position = 1

.PivotFields(colField).Orientation = xlColumnField
.PivotFields(colField).Position = 1

‘ Add each selected data field
For Each field In dataFields
.AddDataField .PivotFields(field), “Sum of ” & field, xlSum
Next field
End With

MsgBox “Pivot Table created successfully with:” & vbNewLine & _
“- Row: ” & rowField & vbNewLine & _
“- Column: ” & colField & vbNewLine & _
“- Data: ” & Join(dataFields, “, “), vbInformation
End Sub