PDA

View Full Version : Convert Table to Range



theta
03-01-2011, 02:22 AM
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
03-01-2011, 02:50 AM
Try unlisting it



ActiveSheet.ListObjects.Item(1).Unlist

Bob Phillips
03-01-2011, 02:52 AM
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
03-01-2011, 03:44 AM
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
03-01-2011, 04:39 AM
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
03-01-2011, 04:50 AM
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
03-01-2011, 05:10 AM
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?