Hi All,

Here is my code, which works fine when the value is assigned, but the
criteria will change each month. For example the - the code will copy all
for the current month in a new worksheet and then name the worksheet the name
of the filter. However, I'll run this macro each month and the name will be
different. HOw can I make it update each time. I put an input box, but am
not able to assign the "Month" chosen.

Sub MakePivots()
Dim sFile
Dim xlBook As Excel.Workbook
Dim xlSheet1 As Worksheet

'OPEN CURRENT MONTH HIRE REPORT
MsgBox "Open this month's HIRE report", [vbOKOnly]
sFile = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
If sFile < False Then
End If

Set xlBook = Workbooks.Open(sFile)
Set xlSheet1 = xlBook.Worksheets("YTD")




'SELECT THE ENTIRE REPORT
Sheets("YTD").Select
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

'SORT THE SELECTION

Selection.Sort Key1:=Range("BL2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


Dim WS As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim Str As String <<<<

THIS IS WHERE THE "MONTH WOULD BE ASSIGNED"
Dim Month As String, Title As String
Dim ChangeMonth As Variant
Month = ""
Title = "Update Month"
ChangeMonth = Application.InputBox(Month, Title)
Dim UserRange As Range


' Display the Input Box
On Error Resume Next
Set UserRange = Application.InputBox( _
Prompt:=Prompt, _
Title:=Title, _
Default:=ActiveCell.Address, _
Type:=8) 'Range selection



Set WS = Sheets("YTD")
Set rng = WS.Range("BL1").CurrentRegion

THIS IS WHERE I ATTEMPT TO ASSIGN THE MONTH<<<<<
Str = Month

'Close AutoFilter first
WS.AutoFilterMode = False


rng.AutoFilter Field:=64, Criteria1:=Str <<<<<-------

Set WSNew = Worksheets.Add

WS.AutoFilter.Range.Copy
With WSNew.Range("A1")
' Paste:=8 will copy the columnwidth in Excel 2000 and higher
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With


WS.AutoFilterMode = False

On Error Resume Next
WSNew.Name = Str <<<<<---------
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0


ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatab ase, SourceData:= _

THIS IS WHERE IT HANGS UP <<<< BECAUSE OF THIS
"Str!R1C1:R667C65").CreatePivotTable TableDestination:="",
TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable1").AddDataFiel d
ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("EMPLID"), "Count of EMPLID", xlCount
With ActiveSheet.PivotTables("PivotTable1").PivotFields ("Title Summ")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields ("DirRpt")
.Orientation = xlColumnField
.Position = 1
End With
End Sub