PDA

View Full Version : Can't resolve "Query too complex" error



dwhite30518
06-11-2012, 02:40 PM
Good evening all!!

I have the following code that I got from others and it works well in my test workbook but when I moved to my live workbook(which is larger), I got the error saying "Query too complex." The code I am using is...

Sub RSAOpenItems()
Dim i As Long
Dim arSQL() As String
Dim objPivotCache As PivotCache
Dim pt As PivotTable
Dim objRS As Object
Dim ws As Worksheet
Dim wsMaster As Worksheet
Dim strsql As String


strsql = Join$(arSQL, " UNION ALL ")

With ActiveWorkbook
Set wsMaster = .Worksheets("Summary")
For Each ws In .Worksheets
If IsNumeric(ws.Name) Then
ReDim Preserve arSQL(i)
arSQL(i) = "SELECT [Item], [RSA], [Serial Rcvd], [Serial Shipped] FROM [" & ws.Name & "$]"
i = i + 1
End If
Next ws
Set objRS = CreateObject("ADODB.Recordset")

objRS.Open Join$(arSQL, " UNION ALL "), Join$(Array("Provider=Microsoft.ACE.OLEDB.12.0; Data Source=", _
.FullName, ";Extended Properties='Excel 12.0 XML;IMEX=1;HEADERS=YES'"), vbNullString)

Set objPivotCache = .PivotCaches.Add(xlExternal)
Set objPivotCache.Recordset = objRS
End With

If wsMaster.PivotTables.Count > 0 Then wsMaster.PivotTables(1).TableRange2.Clear
Set pt = objPivotCache.CreatePivotTable(wsMaster.Range("A3"))
With pt
With .PivotFields("Item")
.Orientation = xlRowField
.Position = 1
End With

With .PivotFields("RSA")
.Orientation = xlRowField
.Position = 2
End With

.ManualUpdate = True

.AddDataField .PivotFields("Serial Rcvd"), " Serial Rcvd", xlCount
.AddDataField .PivotFields("Serial Shipped"), " Serial Shipped", xlCount
.PivotFields(" Serial Rcvd").NumberFormat = "#,##0"
.PivotFields(" Serial Shipped").NumberFormat = "#,##0"


.ShowTableStyleColumnStripes = True
.ShowTableStyleRowStripes = True
.TableStyle2 = "PivotStyleMedium21"
.ColumnGrand = True
.RowGrand = False
.RepeatAllLabels xlRepeatLabels
.DataPivotField.Orientation = xlColumnField
.ManualUpdate = False
.PivotSelect "Item[All;Total]", _
xlDataAndLabel, True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Range("D3").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Range("E3").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, transpose:=False
Application.CutCopyMode = False


With .DataBodyRange
With .Offset(, .Columns.Count)
.EntireColumn.ClearContents
.Cells(0, 1).Value = "Devices owed"
With .Resize(, 1)
.FormulaR1C1 = "=IFERROR(RC[-2]-RC[-1],"""")"
.Cells(0).AutoFilter field:=5, Criteria1:="<>0"
End With
End With
End With

.TableRange1.EntireColumn.AutoFit
End With
ActiveSheet.PivotTables (pt)
Application.ScreenUpdating = True

Set objPivotCache = Nothing
End Sub

I am using Excel 2010 for this workbook and VBA code. I am trying to finish a report and REALLY need this code to work correctly. Can anybody help resolve this error?

Thanks,
Dan