DataRange off by 1 row

[mbarillaro]

I have a pivot table w/ 1 column, no rows and multiple values. When there is not pivotField for my rows, the datarange as I loop through my pivotitems in my pivot table are off by 1 row. So, the datarange returned to me is down 1 row from where the datarange should start. If I set this to True for my pivotTable (DisplayFieldCaptions = True), the dataRange will show the correct dataRange. As anyone seen this issue? A sample of my code is listed below. The pivot table is structured like the following;

1 Column
values for the Rows
Values: price, cost, discounted_price

Dim PvtItem As PivotItem
Dim UnionRng As Range
Dim XRange As Range
Dim pvtTable As PivotTable
Dim pvtParentRowField As Variant
Dim RowFieldNm As Variant

'ActiveSheet Pivot Table
Set pvtTable = ActiveSheet.PivotTables(1)

'Work around to get correct DataRange when there are no row fields
pvtTable.DisplayFieldCaptions = True

'Pivot Tables First RowFields Name
Set pvtParentRowField = pvtTable.RowFields(1)

'Cast pvtParentRowField RowField to RowFieldNm Variant
RowFieldNm = pvtParentRowField

For Each PvtItem In ActiveSheet.PivotTables(1).PivotFields(RowFieldNm).PivotItems
On Error Resume Next

On Error GoTo 0
If Not XRange Is Nothing Then
If UnionRng Is Nothing Then
Set UnionRng = XRange

Else
Set UnionRng = Union(UnionRng, XRange)
End If
End If
Next PvtItem

If DisableLinks = False Then
'Change all pivotCells to look like hyperlinks
UnionRng.Font.Underline = xlUnderlineStyleSingle
UnionRng.Font.Color = RGB(5, 99, 193)
Application.EnableEvents = True
Else
'Reset all pivotCells to remove hyperlinks
UnionRng.Font.Underline = xlUnderlineStyleNone
UnionRng.Font.Color = RGB(0, 0, 0)
Application.EnableEvents = False
End If
End Sub