Task:
I need to get some data from pivot table and copied to the summary file according to specific account managers. Previously, I get the useful macro, however, after I run in the office, it has some problems.
After I use in the office, it has the following problems:
1. If the account manager's name in pivot table is Alexander Dyste-99999*, as I run the macro, in the PCT-After.xls, the data of % Primary sales of closed leads (maturing mortgage
maturing term deposit and signficiant deposit) data will be wrong
2. If the account manager's name in pivot table is gordon d Lam 99999e*, as I run the macro, in the PCT=After.xls, the macro doesn't copy any data in the PCT-after.xls
3. After I run macro, in PCT-after.xls, the date in row 22 (for example), it will be ' in the cell rather than the dd-mm-yy (e.g. 18-Jun-11). I create the similar file at home, it works. I don't why there is problem in the office file.
How can I modify the following code, therefore, I can copy data from pivot table to summary file correctly?
Thank you, if you can give me reply and appreciate your effort
This time, I use more than one hour to prepare PCt-desire result excel and PCt-after.xls.
PCT-DESIRE is for my desired result
PCT-after.xls is my simulation file in office
Option Explicit
Sub test()
Dim PCT As Workbook, main As Workbook, z(1 To 1, 1 To 5), i As Long, pctn, idate, pt As PivotTable, c, firstaddress As String, irow As Long
On Error Resume Next: Set PCT = Workbooks("PCT-after.xls")
If Err.Number <> 0 Then
MsgBox "Please open PCT.xls file and try again", vbCritical: Exit Sub
End If: Set main = ActiveWorkbook: Set pt = main.ActiveSheet.PivotTables(1)
If Err.Number <> 0 Then
MsgBox "Pivot table for processing is not found on activesheet of this workbook", vbCritical: Exit Sub
End If
irow = Application.InputBox("Please enter row number for PCT.xls to input data (same row is used for all students)", Type:=1): If irow = 0 Then Exit Sub
Application.ScreenUpdating = False: With PCT.Sheets("Name List"): pctn = .Range(.[a5], .Cells(Rows.Count, "a").End(xlUp)): End With: With main.Sheets(1)
idate = .[d1:d100].Find("Report Date:", , xlValues, xlWhole).Offset(, 1): With pt
For i = 1 To UBound(pctn)
Set c = .TableRange1.Find(pctn(i, 1), , xlValues, xlPart)
If Not c Is Nothing Then
firstaddress = c.Address
Do
If c.PivotCell.PivotCellType = xlPivotCellSubtotal Then
z(1, 1) = c.Offset(, 3): z(1, 2) = c.Offset(, 5)
z(1, 3) = .GetData("' % primary sales of closed leads' 'Campaign Name' 'maturing mortgage' 'RM Name'" & Trim(pctn(i, 1)) & " 99999*")
z(1, 4) = .GetData("' % Primary sales of closed leads' 'Campaign Name' 'maturing term deposit' 'RM Name'" & Trim(pctn(i, 1)) & " 99999*")
z(1, 5) = .GetData("' % Primary sales of closed leads' 'Campaign Name' 'signficiant deposit' 'RM Name'" & Trim(pctn(i, 1)) & " 99999*")
With PCT.Sheets(Trim(pctn(i, 1)))
With .Cells(irow, 1): .Value = "'" & idate: With .Offset(, 26).Resize(, 5): .Value = z: .NumberFormat = "0.00%"
End With: End With: End With: End If: Set c = .TableRange1.FindNext(c): Loop Until c Is Nothing Or c.Address = firstaddress
End If: Next: End With: End With: Application.ScreenUpdating = True: End Sub
Bookmarks