Convert Table to Range

[theta]

Hi

When using the following bit of code, the table (Table1 - which was the result of an XML import) becomes a normal range. All numbers stored as text become values, all borders and shading disappear...and autofilter can then be applied to Rows(1). This is perfect, until the UsedRange gets too large. Error 7 : Out of Memory.

With oWS
     .UsedRange.Value = oWS.UsedRange.Value

I tried to get round this by using the following, but it does not convert the table to a range and so when I select Rows(1) (part table / part normal ranges) I cannot apply and autofilter

Dim Col As Range
    For Each Col In oWS.UsedRange.Columns
        Col.Value = Col.Value
Next Col

The 2 codes are effectively doing the same thing, with the latter breaking it down into smaller ranges.

Any help appreciated as this is the only bug I have left to fix!

Kind regards

[Bob Phillips]

Try unlisting it

[vba]

ActiveSheet.ListObjects.Item(1).Unlist
[/vba]

[Bob Phillips]

BTW, isn't that XML data all being text a real pain. I had a DSUM that was testing one column for <3, <6 and so on, and it took me ages to find why it didn't work.

[theta]

It is a bit of a pain! But I am having to finish a project that was left half finished.

I would like to have used ADO and SQL only pulling in the record I require

The macro now works great. But fails (on the larger data set) when trying to produce the pivottable. But works fine on the smaller data set.

More fun times ahead...

[Bob Phillips]

When you say large, how many rows? I would like to be forewarned in case I come across this problem later.

Why not query the pivot directly against the data?

[theta]

The macro to produce the pivot is :

(I inserted a MsgBox the retrieve the dimension = "127385 Rows 81 Columns")

Private Function CreateXMLpivots(owb As Workbook, oWS As Worksheet) As Boolean
'Purpose: Create Pivots from source XML data
    Dim oPC As PivotCache
    Dim oPT As PivotTable
    
    Dim nLastRow As Long, nLastCol As Long
    
    On Error Resume Next 'GoTo ErrHandler
        
    nLastRow = Last("Row", oWS.UsedRange)
    nLastCol = Last("Col", oWS.UsedRange)
    
    MsgBox (nLastRow & " Rows " & nLastCol & " Columns")
    
    Set oPC = owb.PivotCaches.Create(xlDatabase, oWS.Range(oWS.Cells(1, 1), oWS.Cells(nLastRow, nLastCol)))
    
    owb.Worksheets.Add(after:=owb.Worksheets(owb.Worksheets.Count)).Name = "HPMN"
    owb.Sheets("HPMN").Tab.Color = 49407
    
    Set oPT = oPC.CreatePivotTable(owb.Sheets("HPMN").Range("A1"), "HPMN Codes", True)
    
    With oPT
        .DisplayFieldCaptions = True
        .ColumnGrand = True
        .SaveData = False
    End With
    
    'Add Data fields first, otherwise RowField is replaced
    oPT.AddDataField field:=oPT.PivotFields("TapSeqNo"), Function:=xlMin
    oPT.AddDataField field:=oPT.PivotFields("TapSeqNo"), Function:=xlMax
    oPT.AddDataField field:=oPT.PivotFields("TotalNetCharge"), Function:=xlSum
    oPT.AddDataField field:=oPT.PivotFields("TotalTax"), Function:=xlSum
    oPT.AddFields RowFields:=oPT.PivotFields("HPMN").Name
    oPT.TableRange1.Columns(2).NumberFormat = "#,###,##0"
    oPT.TableRange1.Columns(3).NumberFormat = "#,###,##0"
    oPT.TableRange1.Columns(4).NumberFormat = "#,###,##0.00"
    oPT.TableRange1.Columns(5).NumberFormat = "#,###,##0.00"
    owb.Sheets("HPMN").Range("A3").Select
    ActiveWindow.FreezePanes = True
    
    If owb.Sheets("HPMN").PivotTables.Count > 0 Then
       frmWait.lbxInfo.AddItem "HPMN Pivot created"
       CreateXMLpivots = True
    Else
       frmWait.lbxInfo.AddItem "*** HPMN Pivot NOT created ***"
       CreateXMLpivots = False
    End If
TheEnd:
    Set oPC = Nothing
    Set oPT = Nothing
    Exit Function
ErrHandler:
    Call LogErr("CreateXMLpivots", Err.Number, Err.Description)
    GoTo TheEnd
End Function

[theta]

Just deactivated the lovely error handler. I get the error :

"Error -2147352567 Method 'Create' of Object 'PivotCaches' failed"

When I create the pivot manually, no issues

Any ideas?