Variant

C

CV323

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 RangeDim 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
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:=xlDatabase, SourceData:= _
TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable1").AddDataField
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
 
D

dkinn

If you are looking for the month function to return a number equal to the
month IE Feb =2
then you have to use something like the following

Str=month(now)

Month has to have a date to work on
David

CV323 said:
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 RangeDim 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
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:=xlDatabase, SourceData:= _
TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable1").AddDataField
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
Click to expand...
 
C

CV323

Thanks David

I'm getting hung up at the pivots, any suggestions?

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

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


Str = Month(Now)

'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

'>>>>>>>>BEGINNING HERE - I'm not sure if its just that it's not recognizing
"Str!" sheet name???

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
("Str!R1C1:R667C65").CreatePivotTable TableDestination:="",
(TableName:= "PivotTable1", DefaultVersion:=xlPivotTableVersion10)
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable1").AddDataField
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







dkinn said:
If you are looking for the month function to return a number equal to the
month IE Feb =2
then you have to use something like the following

Str=month(now)

Month has to have a date to work on
David

CV323 said:
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 <<<<
Click to expand...
THIS IS WHERE THE "MONTH WOULD BE ASSIGNED"
Click to expand...
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<<<<<
Click to expand...
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:=xlDatabase, SourceData:= _
THIS IS WHERE IT HANGS UP <<<< BECAUSE OF THIS
"Str!R1C1:R667C65").CreatePivotTable TableDestination:="",
Click to expand...
TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable1").AddDataField
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
Click to expand...
Click to expand...
 
D

dkinn

I haven't played around with pivot tables in a long time so bear with me
but I think you are right on the problem

you are passing a text string as the argument and vba can't figure out the
sheet name

try something like

ws.Name & "!R1C1:R667C65"

this way the name of the worksheet gets evaluated properly


SourceData:= _
(ws.Name & "!R1C1:R667C65").CreatePivotTable TableDestination:="",


David

CV323 said:
Thanks David

I'm getting hung up at the pivots, any suggestions?

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

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


Str = Month(Now)

'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

'>>>>>>>>BEGINNING HERE - I'm not sure if its just that it's not recognizing
"Str!" sheet name???

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
("Str!R1C1:R667C65").CreatePivotTable TableDestination:="",
(TableName:= "PivotTable1", DefaultVersion:=xlPivotTableVersion10)
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable1").AddDataField
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







dkinn said:
If you are looking for the month function to return a number equal to the
month IE Feb =2
then you have to use something like the following

Str=month(now)

Month has to have a date to work on
David

CV323 said:
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:=xlDatabase, 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").AddDataField
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
Click to expand...
Click to expand...
Click to expand...
 
T

Tom Ogilvy

fiirst, str is a vba function. Bad choice using it as a variable name. Try

Dim sStr As String

sStr = Month(Now)

WSNew.Name = sStr


Now, the parentheses are unbalanced:

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"'" & wsNew.Name & "'!R1C1:R667C65").CreatePivotTable TableDestination:="",


or
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"'" & sStr & "'!R1C1:R667C65").CreatePivotTable TableDestination:="",


--
Reards,
Tom Ogilvy


dkinn said:
I haven't played around with pivot tables in a long time so bear with me
but I think you are right on the problem

you are passing a text string as the argument and vba can't figure out the
sheet name

try something like

ws.Name & "!R1C1:R667C65"

this way the name of the worksheet gets evaluated properly


SourceData:= _
(ws.Name & "!R1C1:R667C65").CreatePivotTable TableDestination:="",


David

CV323 said:
Thanks David

I'm getting hung up at the pivots, any suggestions?

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

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


Str = Month(Now)

'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

'>>>>>>>>BEGINNING HERE - I'm not sure if its just that it's not recognizing
"Str!" sheet name???

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
("Str!R1C1:R667C65").CreatePivotTable TableDestination:="",
(TableName:= "PivotTable1", DefaultVersion:=xlPivotTableVersion10)
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable1").AddDataField
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







dkinn said:
If you are looking for the month function to return a number equal to the
month IE Feb =2
then you have to use something like the following

Str=month(now)

Month has to have a date to work on
David

:

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:=xlDatabase, 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").AddDataField
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
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA Pivot Table Error 1
delete selection in pivotcolumn 3
Remover ODBC Dialog Box 0
Format Pivot total rows 2
Suggestions... 0
Loop through sheets and create a small PivotTable on each 2
syntax in VBA to create a pivot table 2
Programming a pivot 0

Top