run-time error 1004: Cannot change this part of a PivotTable report

I have a report that I run on a weekly basis and have not had an issue with it until it started pulling in August data. It's a set of three pivot tables that pull data in from an Access database. Attached is a snapshot of the report with the three tabs... the first tab runs fine but when I try to run the second and third I get the following error message:

"run-time error 1004: Cannot change this part of a PivotTable report"

When I go in to debug the error it brings me to the following line in the code:

'add YTD header
Cells(lProw + 1, iLcol + 1).Value = "YTD"

I have a feeling that since we're now in August and theres three columns per month we're going over the 26 columns, as referenced at the bottom of the code. But I'm not sure where to go from there.

Here's the code
------------------------------------
Sub AddYTDColumns()
Dim iCol As Integer
Dim iEcol As Integer 'last column for month
Dim iFcol As Integer 'first month column
Dim iLcol As Integer 'last column
Dim iSums As Integer
Dim lDrow As Long 'first data row
Dim lLrow As Long 'last row of ptable
Dim lProw As Long '1st ptable row
Dim lRow As Long
Dim sAcell As String 'activecell address
Dim pt As PivotTables
Dim wS As Worksheet
Dim vSums() As Variant

Set wS = Sheets(ActiveSheet.Name)
Set pt = wS.PivotTables
'exit if no pivot tables on active sheet
If pt.Count = 0 Then Exit Sub

'store activecell to be reselected at end
sAcell = ActiveCell.Address

'first row of pivot table
lProw = pt.Item(1).TableRange1.Row
'first row of data (hours) area
lDrow = pt.Item(1).DataBodyRange.Row

'get pivot table address
i = pt.Item(1).TableRange1.Address
'find last $
j = InStrRev(i, "$")
'last row of pivot table
lLrow = Mid(i, j + 1)
'last column of pivot table
k = InStr(i, ":$")
l = Mid(i, k + 2, Len(j - k + 2))
iLcol = Columns(l).Column

'clear current YTD columns
ClearYTD lProw, lLrow, iLcol

'find first month (data area)
iFcol = pt.Item(1).DataBodyRange.Column
'row w/ hourtypes
lRow = lProw + 2

x = Cells(lRow, iFcol)
For iEcol = iFcol + 1 To iLcol
Y = Cells(lRow, iEcol).Value
If Y = x Or Y = "" Then
iEcol = iEcol - 1
Exit For
End If
Next

'add YTD header
Cells(lProw + 1, iLcol + 1).Value = "YTD"
'copy & paste hourtype headers from first month
Range(Cells(lRow, iFcol), Cells(lRow, iEcol)).Copy
Cells(lRow, iLcol + 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False

'calc # of types, create array with sum formulas for each type
iSums = iEcol - iFcol

ReDim vSums(iSums)

For i = 0 To UBound(vSums)
vSums(i) = "=SUM("
Next

'loop thru months, create a total sum for each type
For iEcol = iFcol To iLcol Step iSums + 1
For i = 0 To UBound(vSums)
'add type column to sum statement, for last month add ')', otherwise add a ','
vSums(i) = vSums(i) & ColLtr(iEcol + i) & lDrow & _
IIf(iEcol >= iLcol - iSums, ")", ",")
Next
Next

'add formulas from array to 1st row of YTD column, use autofill to copy formulas
' to other cells in columns
For iCol = iLcol + 1 To iLcol + iSums + 1
i = iCol - (iLcol + 1)
Cells(lDrow, iCol).Formula = vSums(i)
Cells(lDrow, iCol).Select
x = ColLtr(iCol)
Selection.AutoFill Destination:=Range(x & lDrow & ":" & x & lLrow)
Next

'copy formats from first month to YTD columns
iEcol = iFcol + iSums
lRow = lProw + 1

Range(ColLtr(iFcol) & lRow & ":" & ColLtr(iEcol) & lLrow).Select
Selection.Copy
Cells(lRow, iLcol + 1).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Range(ColLtr(iLcol + 1) & lRow & ":" & ColLtr(iLcol + iSums + 1) & lLrow).Select
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous

'store last row
lLPrevRow = lLrow
Range(sAcell).Select

End Sub

Private Sub ClearYTD(lProw As Long, ByVal lLrow As Long, iLcol As Integer)
'clear YTD columns
Dim iCol As Integer
Dim iEcol As Integer
Dim lRow As Long

'determine last row
If lLPrevRow > lLrow Then lLrow = lLPrevRow

'find YTD columns
lRow = lProw + 1
For iCol = iLcol + 1 To 256
If Cells(lRow, iCol).Value = "YTD" Then
lRow = lRow + 1
'if YTD found then determine # of YTD columns to be cleared
For iEcol = iCol To 256
If Cells(lRow, iEcol).Value = "" Then
If iEcol > iLcol + 1 Then iEcol = iEcol - 1
Exit For
End If
Next
If iEcol >= 256 Then iEcol = iCol + 1
Exit For
End If
Next

If iCol >= 256 Then Exit Sub

'select YTD columns
Range(ColLtr(iLcol + 1) & lProw & ":" & ColLtr(iEcol) & lLrow).Select

'clear data
Selection.ClearContents
'clear formating
With Selection.Interior
.ColorIndex = 2
.PatternColorIndex = xlAutomatic
End With
NoBorders
End Sub

Private Sub NoBorders()
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

'****************************************************************************************
'translate passed column# into it's letter equivalent, uses Chr function to change number
' to letter (Ascii A = 65, Z = 90 so add 64), for columns over 26 divide the number by
' 26, the first letter will be the quotient the second will be the remainder (mod)
Public Function ColLtr(ByVal iColNo As Integer) As String
Dim iMod As Integer
Dim sCol As String

If iColNo >= 1 And iColNo <= 26 Then
sCol = Chr(iColNo + 64)
Else
iMod = iColNo Mod 26
If iMod = 0 Then iMod = 26
iColNo = iColNo - iMod
iColNo = iColNo / 26
sCol = Chr(iColNo + 64) + Chr(iMod + 64)
End If

ColLtr = sCol

End Function