CODEWITHSUNDEEP
vbaexcelpivot-table
Telpek
Telpek

Reputation: 23

Adding a pivot table to a new sheet with data on the same sheet

My code creates a new sheet as per below code which is ws2 where I have a table extracted from ws1. I want to place a pivot table on the same sheet ws2 in cell "L4" as per bottom part of the code, but it would not work.

Sub ClickThisMacro()

Dim i As Long
Dim y As Long
Dim n As Long

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Report")

Dim ws2 As Worksheet: Set ws2 = Sheets.Add

Set rng1 = ws1.Range("A:A").Find("Name")

fr = rng1.Row
lr = ws1.Range("B" & Rows.Count).End(xlUp).Row
y = 2

For i = fr + 1 To lr
    ws2.Cells(y, 1) = ws1.Cells(i, 1)
    ws2.Cells(y, 2) = ws1.Cells(i, 2)
    ws2.Cells(y, 3) = ws1.Cells(i, 3)
    ws2.Cells(y, 4) = ws1.Cells(i, 4)
    ws2.Cells(y, 5) = ws1.Cells(i, 18)

    y = y + 1
Next i

ws2.Cells(1, 1) = "Cost centre name"
ws2.Cells(1, 2) = "Cost centre code"
ws2.Cells(1, 3) = "Phone number"
ws2.Cells(1, 4) = "User name"
ws2.Cells(1, 5) = "Amount"

LastRow = ws2.Range("A1").End(xlDown).Row

' making columns C and F numbers
ws2.Range("C2:C" & LastRow).Select

For Each xCell In Selection
    xCell.Value = xCell.Value
Next xCell

With ws2.UsedRange.Columns(5)
    .Replace "£", "", xlPart
    .NumberFormat = "#,##0.00"
    .Formula = .Value
End With

With ws2.UsedRange.Columns(8)
    .Replace "£", "", xlPart
    .NumberFormat = "#,##0.00"
    .Formula = .Value
End With

'Pivot table
Dim mypivot As PivotTable
Dim mycache As PivotCache

Set mycache = ws2.PivotCaches.Create(xlDatabase, Range("a1").CurrentRegion)

Set mypivot = ws2.PivotTables.Add(mycache.Range("l4"), "Mypivot1")

mypivot.PivotFields("Cost centre name").Orientation = xlRowField
mypivot.PivotFields("Cost centre code").Orientation = xlColumnField
mypivot.PivotFields("Amount").Orientation = xlDataField

End Sub

Upvotes: 2

Views: 75

Answers (1)

Shai Rado
Shai Rado

Reputation: 33692

You have a few syntax errors in your code at the section where you set your PivotCache and PivotTable objects.

Modified code (Pivot-Table section)

' set the Pivot-Cache
Set mycache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=ws2.Range("A1").CurrentRegion.Address(False, False, xlA1, xlExternal))

' set the Pivot-Table object
Set mypivot = ws2.PivotTables.Add(PivotCache:=mycache, TableDestination:=ws2.Range("L4"), TableName:="Mypivot1")

With mypivot
    .PivotFields("Cost centre name").Orientation = xlRowField
    .PivotFields("Cost centre code").Orientation = xlColumnField
    .PivotFields("Amount").Orientation = xlDataField
End With

Some Other modifications/suggestions you should add to your code:

  1. Using Find you should handle a scenario (even though unlikely) that you won't find the term you are looking for, in that case if Rng1 = Nothing then fr = Rng1.Row will result with a run-time error.

Dealing with Find code:

Set Rng1 = ws1.Range("A:A").Find("Name")
If Not Rng1 Is Nothing Then ' confirm Find was successfull
    fr = Rng1.Row
Else ' if Find fails
    MsgBox "Critical Error, couldn't find 'Name' in column A", vbCritical
    Exit Sub
End If
  1. You should avoid using Select and Selection, you can use fully qualified Range object instead:

Looping through a Range:

For Each xCell In ws2.Range("C2:C" & lr)
    xCell.Value = xCell.Value
Next xCell

Upvotes: 1

Related Questions