Creating a pivot table with multiple sheets

[xlsaffer]

Hi
I am trying to create a pivot table using multiple sheets. I looking for some code that will replace the "consolidated ranges" in the Pivot Table Wizard. I am looking for code because I am writing a macro that will create a different number of worksheets in the Workfile, depending on which dataset I use. i.e File 1 may have 75 worksheets, whereas File 2 may have 120 worksheets. '

The ranges on each of the worksheets will be the same. Range("A2:Av48")

Any help or directions to other references will be gratefully received.

Thanks

 

[tightwad]

Post 18 doesn't have the same error message; whatever the problem was then was sorted out by using the earlier posted code. I think that is a 'red herring' wrt to the current difficulties.

Post #46's error message was to do with the SQL. I don't know how/if that has been addressed, or why it is now (post #48) thought that the only problem is 'the Excel 8.0 part'.

Excel 8.0 is in the connection string. I think one of the earlier posts will have a link to information on connection strings.

PS. Post #21 has a link for connection strings. F

As I said, I was just unsure of the connection string part, as I didn't understand it. Using the links provided I now understand that Excel 8.0 is used for workbooks from excel 97 and newer, so that is not the problem here (using 2003).

 

[Fazza]

hi, tightwad. You posted that there was a problem with the SQL; then that the only concern was being unsure of the Excel 8 reference (though it wasn't a problem?). Now the connection string "is not the problem here". That means the error with the SQL still exists?

If so, can you check your file set up matches that assumed for the code? I think that is as simple as described in post #3 (where the code is posted), "it is assumed that every worksheet has data."

 

[tightwad]

hi, tightwad. You posted that there was a problem with the SQL; then that the only concern was being unsure of the Excel 8 reference (though it wasn't a problem?). Now the connection string "is not the problem here". That means the error with the SQL still exists?

If so, can you check your file set up matches that assumed for the code? I think that is as simple as described in post #3 (where the code is posted), "it is assumed that every worksheet has data."

I was finally able to figure out the issue with the original code I was using, and it turned out it was because you can only do 50 unions within SQL. I created tables using 50 unions per table, then unioned the tables and it worked. I will post the working code I used in the morning, as I am not at work where it is.

 

[Fazza]

OK, great work.

 

[tightwad]

I was finally able to figure out the issue with the original code I was using, and it turned out it was because you can only do 50 unions within SQL. I created tables using 50 unions per table, then unioned the tables and it worked. I will post the working code I used in the morning, as I am not at work where it is.

Below is the code I am now using. I spent the better part of this morning trying to figure out how to do away with the temp file, as it adds a TON of time to the creation of the PT, but in the end I was unable to do so...I don't understand the ODBC settings well enough, and I couldn't maintain a connection with the linked table (it worked until I saved it after running it once and re-running it). I think this would allow about 2300 sheets to be Pivoted...way more than I need!

Sub CreateConnection()
    Dim strFileExt As String
    Dim lngFileFormat As Long
    Dim PT As PivotTable
    Dim PC As PivotCache
    Dim strFile As String
    Dim strFileTemp As String
    Dim strPath As String
    Dim arrSheets As Variant
    Dim strSQL As String
    Dim strSQLtemp As String
    Dim strCon As String
    Dim i As Long

    
    '   Sheets to consolidate
    '*****************************************************************************
    'arrSheets = Array("Ontario", "Alberta")
    
Dim ws As Worksheet
ReDim arrSheets(0)
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = "SQL" Then GoTo 1
        If ws.Name <> ActiveSheet.Name Then
            arrSheets(UBound(arrSheets)) = ws.Name
            ReDim Preserve arrSheets(UBound(arrSheets) + 1)
    End If
1: Next ws
ReDim Preserve arrSheets(UBound(arrSheets) - 1)

' Sheets to consolidate
'*****************************************************************************
    
    If Val(Application.Version) > 11 Then
        DeleteConnections_12
        CheckFileFormat_12
    Else
        strFileExt = ".xls"
        lngFileFormat = xlNormal
    End If
    
    Application.ScreenUpdating = False
    With ThisWorkbook
        strPath = .Path
        strFile = .FullName
        strFileTemp = strPath & "\DBtemp" & Format(Now, "yyyymmddhhmmss") & strFileExt
        ActiveSheet.Cells.Clear
        .Worksheets(arrSheets).Copy '''This takes a LONG time
    End With
 
    With ActiveWorkbook
        .SaveAs strFileTemp, lngFileFormat '''This takes a LONG time
        .Close
    End With
    'strSQL = ""
    For i = LBound(arrSheets) To Application.WorksheetFunction.Min(i + 45, UBound(arrSheets))
        If arrSheets(i) <> ActiveSheet.Name Then
            If strSQL = "" Then
                strSQL = "(SELECT * FROM [" & arrSheets(i) & "$]"
            Else
                strSQL = strSQL & " UNION ALL SELECT * FROM [" & arrSheets(i) & "$]"
            End If
        End If
        DoEvents
    Next i
    strSQL = strSQL & ") a"
    strSQL = "Select * from " & strSQL
    '''''Next section accounts for sheets > 45'''''
    Do While i <= UBound(arrSheets)
        strSQLtemp = ""
        If i <= UBound(arrSheets) Then
            For i = i To Application.WorksheetFunction.Min(i + 45, UBound(arrSheets))
                If arrSheets(i) <> ActiveSheet.Name Then
                    If strSQLtemp = "" Then
                        strSQLtemp = "(SELECT * FROM [" & arrSheets(i) & "$]"
                    Else
                        strSQLtemp = strSQLtemp & " UNION ALL SELECT * FROM [" & arrSheets(i) & "$]"
                    End If
                End If
                DoEvents
            Next i
        strSQLtemp = strSQLtemp & ") b"
        strSQL = strSQL & " UNION ALL " & "Select * from " & strSQLtemp
        End If
   Loop
   
   ''''End of sheets > 45'''''
    strCon = _
        "ODBC;" & _
        "DSN=Excel Files;" & _
        "DBQ=" & strFileTemp & ";" & _
        "DefaultDir=" & strPath & ";" & _
        "DriverId=790;" & _
        "MaxBufferSize=2048;" & _
        "PageTimeout=5"
    MsgBox ThisWorkbook.PivotCaches.Count
    Set PC = ThisWorkbook.PivotCaches.Add(SourceType:=xlExternal)
    
    With PC
        .Connection = strCon
        .CommandType = xlCmdSql
        .CommandText = strSQL
        Set PT = .CreatePivotTable(TableDestination:=ActiveSheet.Range("A16"))
        PT.Name = "TestPivot"
    End With
        
    With PT.PivotCache
        .Connection = Replace(strCon, strFileTemp, strFile)
    End With
    
    'Clean up
    Kill strFileTemp
    Set PT = Nothing
    Set PC = Nothing
End Sub

 

[Fazza]

hi tightwad.

Here is a way without the temporary file - for up to 650 worksheets.

I thought to try breaking up the SQL into smaller bites, each UNION'd together. Keeping each bite below the 50 table limit. So instead of a single UNION [ALL] of say 180 tables (and you've shown the limit is 49), there would be 4 bites each up to 49 and those 4 smaller bites UNION'd.

Testing with a maximum bite of 49, worked OK on up to 98 tables. It errored again with 99 tables. Seems the UNION of a bite of 49 with one more table was again the problem.

So, I tried reducing the bite. With bite size 48, the limit was 144 tables.

Extending this, for different bite sizes, the maximum tables UNIONable is
bite x maximum
49 2 98
49 3 144
47 4 188
...
29 22 638
28 23 644
27 24 648
26 25 650
25 26 650
24 27 648
23 28 644

So, a bit size of 25 or 26 gave the maximum number of tables that could be UNION'd.

Code below. For me, this is academic. I never need to join even 50 tables. Though I guess one could cascade the whole idea to the next level, successively joining tables within the limit and cascading up a level - if you know what I mean. This could handle thousands of tables? I won't pursue this. Anyone with more than 650 tables should use a different structure.

regards, Fazza

Sub all_worksheets_to_PT_Excel_2003()
 
  Const lngMAX_UNIONS As Long = 25
 
  Dim i As Long, j As Long
  Dim arSQL() As String
  Dim arTemp() As String
  Dim objPivotCache As PivotCache
  Dim objRS As Object
  Dim wbkNew As Workbook
 
  ReDim arTemp(1 To lngMAX_UNIONS)
 
  With ActiveWorkbook
    ReDim arSQL(1 To (.Worksheets.Count - 1) \ lngMAX_UNIONS + 1)
 
    For i = LBound(arSQL) To UBound(arSQL) - 1
      For j = LBound(arTemp) To UBound(arTemp)
        arTemp(j) = "SELECT * FROM [" & .Worksheets((i - 1) * lngMAX_UNIONS + j).Name & "$]"
      Next j
      arSQL(i) = "(" & Join$(arTemp, vbCr & "UNION ALL ") & ")"
    Next i
 
    ReDim arTemp(1 To .Worksheets.Count - (i - 1) * lngMAX_UNIONS)
    For j = LBound(arTemp) To UBound(arTemp)
      arTemp(j) = "SELECT * FROM [" & .Worksheets((i - 1) * lngMAX_UNIONS + j).Name & "$]"
    Next j
    arSQL(i) = "(" & Join$(arTemp, vbCr & "UNION ALL ") & ")"
 
    Set objRS = CreateObject("ADODB.Recordset")
    objRS.Open Join$(arSQL, vbCr & "UNION ALL" & vbCr), _
        Join$(Array("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=", _
        .FullName, ";Extended Properties=""Excel 8.0;"""), vbNullString)
 
  End With
 
  Set wbkNew = Workbooks.Add(Template:=xlWBATWorksheet)
 
  With wbkNew
    Set objPivotCache = .PivotCaches.Add(xlExternal)
    Set objPivotCache.Recordset = objRS
    Set objRS = Nothing
 
    With .Worksheets(1)
      objPivotCache.CreatePivotTable TableDestination:=.Range("A3")
      Set objPivotCache = Nothing

'      'sample of pivot table
'      With .PivotTables(1)
'        .PivotFields("Company").Orientation = xlPageField
'        .PivotFields("Department").Orientation = xlRowField
'        .PivotFields("Year").Orientation = xlColumnField
'        .PivotFields("Cost").Orientation = xlDataField
'      End With
 
    End With
  End With
  Set wbkNew = Nothing
 
End Sub

 

[Fazza]

Minor correction.

Instead of,

Extending this, for different bite sizes, the maximum tables UNIONable is
bite x maximum
49 2 98
49 3 144
47 4 188

Should be,

Extending this, for different bite sizes, the maximum tables UNIONable is
bite x maximum
49 2 98
48 3 144
47 4 188

 

[tightwad]

Can you explain the following part? I know it is a simple thing, but I don't understand it...and I think if I did this would all make a lot more sense!

    objRS.Open Join$(arSQL, vbCr & "UNION ALL" & vbCr), _
        Join$(Array("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=", _
        .FullName, ";Extended Properties=""Excel 8.0;"""), vbNullString)

What does each section do? What does "Join$" mean?


Regarding max tables, I think you are seeing the max you are through the following logic:

Union first x tables
Union second x tables
Union third x tables

Etc, etc....until the end, at which point you union the first xx unions with the last x tables...IE

 Union1code & "UNION ALL " 
& Union2code & "UNION ALL " 
& UNION3code & "UNION ALL " 
& Table1 & "UNION ALL " 
& Table2 & "UNION ALL " 
& Table3 & "UNION ALL " 
& Table4 & "UNION ALL " 
& Table5

So the end of the statement uses 25 unions for 25 tables, where the first part was using groups of 25 tables in a single code, then Union ALL with the rest. That is why all of your:

49 2 98
48 3 144
47 4 188

Has the first 2 values summing to 51

 

[Fazza]

Can you explain the following part? I know it is a simple thing, but I don't understand it...and I think if I did this would all make a lot more sense!

    objRS.Open Join$(arSQL, vbCr & "UNION ALL" & vbCr), _
        Join$(Array("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=", _
        .FullName, ";Extended Properties=""Excel 8.0;"""), vbNullString)

What does each section do? What does "Join$" mean?

Join puts the different bits together - VBA help refers. So,
join(array("one", "two", "three)," JOINER ")
becomes the string
one JOINER two JOINER three

The first one in the VBA uses some carriage returns together with "UNION ALL" to make a string like
"one
UNION ALL
two
UNION ALL
three"

The second makes the connection string, the joiner is a null string, or nothing. To make a string like
"onetwothree"

HTH

 

[tightwad]

thanks, that make sense!