Macro code to build a pivot table consolidated from multiple sheets

[stu40]

Firstly I would like to say well done to everyone who contributes to this forum. This website ranks in the top of google for excel related searches.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
I have been using the code from the post ‘VBA Consolidating Multiple Sheets in a Pivot Table’ successfully (http://www.mrexcel.com/forum/showthread.php?t=389230), (code pasted below) but I’ve run into an issue when I try to paste VBA code onto the end, that builds the finished pivot table. The ‘ActiveSheet.PivotTables’ name is PivotTable1 (see my macro recorder code below), but if I run the macro more than once, I get a compile error at that line where ActiveSheet.PivotTables "PivotTable1" first occurs (I think because the name has incremented by one ie. PivotTable2 etc).<o></o>


<o></o>

• Could someone post a code amendment to make the macro compile successfully no matter how many times the macro is run?<o></o>

<o></o>

• Could you also post code to make the name of the new sheet where the pivot table is created to be “Referrals”<o></o>

<o></o>
I’m using Excel 2003.
<o></o>
<o></o>
Thank you in advance for your assistance!

Stuart

---------------------<o></o>
<o></o>
Sub g_To_Be_Complet_Ref_table()<o></o>
<o></o>
'<o></o>
' Here’s the code from the post “VBA Consolidating Multiple Sheets in a Pivot Table”
' http://www.mrexcel.com/forum/showthread.php?t=389230
'<o></o>
<o></o>
Dim i As Long<o></o>
Dim arSQL() As String<o></o>
Dim objPivotCache As PivotCache<o></o>
Dim objRS As Object<o></o>
Dim wks As Worksheet<o></o>
Dim ws2 As Worksheet<o></o>
With ActiveWorkbook<o></o>
ReDim arSQL(1 To .Worksheets.Count)<o></o>
For Each wks In .Worksheets<o></o>
i = i + 1<o></o>
arSQL(i) = "SELECT * FROM [" & wks.Name & "$]"<o></o>
Next wks<o></o>
Set wks = Nothing<o></o>
Set objRS = CreateObject("ADODB.Recordset")<o></o>
<o></o>
objRS.Open Join$(arSQL, " UNION ALL "), _<o></o>
Join$(Array("Provider=Microsoft.jet.OLEDB.4.0; Data Source=", _<o></o>
.FullName, ";Extended Properties=""Excel 8.0;"""), vbNullString)<o></o>
Set objPivotCache = .PivotCaches.Add(xlExternal)<o></o>
Set objPivotCache.Recordset = objRS<o></o>
Set objRS = Nothing<o></o>
End With<o></o>
Set ws2 = Worksheets.Add<o></o>
With ws2<o></o>
objPivotCache.CreatePivotTable TableDestination:=.Range("A3")<o></o>
Set objPivotCache = Nothing<o></o>
.Range("A3").Select<o></o>
End With<o></o>
<o></o>
'<o></o>
' Here’s my own code I made with the macro recorder, to create the finished pivot table<o></o>
' <o></o>
<o></o>
Range("B4").Select<o></o>
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Staff Responsible")<o></o>
.Orientation = xlRowField<o></o>
.Position = 1<o></o>
End With<o></o>
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Type")<o></o>
.Orientation = xlColumnField<o></o>
.Position = 1<o></o>
End With<o></o>
<o></o>
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Start" _<o></o>
)<o></o>
.Orientation = xlColumnField<o></o>
.Position = 1<o></o>
End With<o></o>
<o></o>
<o></o>
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _<o></o>
"PivotTable1").PivotFields("Last Name"), "Count of Last Name", xlCount<o></o>
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Type")<o></o>
<o></o>
End With<o></o>
<o></o>
End Sub<o></o>

 

[pbornemeier]

Welcome to the Board!

Throughout the code change:
ActiveSheet.PivotTables("PivotTable1")
to
ActiveSheet.PivotTables(1)
this will then reference the first PT on the worksheet rather than the one named "PivotTable1"

Immediately after:
With ws2<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>

add
ws2.Name = "Referrals"

When posting code, use the code tags = it preserves indenting of the code and makes it easier to read. (See link in my sig)

 

[stu40]

That amendment worked like a charm - thanks Phil. I appreciate your help.

I will use the code tags next time I post as well.

cheers,
Stuart

 

[jorgenbu]

Dear Excel and VBA experts!

This is a very elenant and well working piece of code.
However, it seems that it truncates to include all data a bit after line 12000.

Any known remedy for that?

Regards Jørgen Bugge

 

[pbornemeier]

I can see nothing in the code that would cause truncation. Please provide more details of your problem in a new post that references this one.

 

[jorgenbu]

Hi Phil,

Thanks for your answer. It triggered some suspicions that my code as derived from the example above had some flaws.

It proved out I had been wrong in using SELECT DISTINCT. Having removed the distinct, it's no problem anymore.

Thanks again!

BR, Jørgen