[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1992
  • Last Modified:

Copy Pivot table problem

Hi,
I have developed a macro using (copied / pasted / hi-jacked) code from all over this site to make a great time-saver when transferring data from a workbook we get every week from our customer, to a couple of workbooks on our server at work.

The code works great if I copy and paste the pivot table from the customer workbook to a new sheet into the workbook where the macro is.
I tried adding lines which would add a new sheet and paste the pivot table automatically into that sheet when the workbook opens but keep getting the error message "Cannot enter a null value as an item or field name in a Pivot Table report."

The lines I added in the enclosed code are 32 and 33

As I said, if I copy and paste the pivot table into a new sheet and then run the macro after commenting out lines 32 and 33 it works fine.

I have tried a few things with the paste values etc, but later on in the code it copies the pivot table values to an intermediate workbook, so I didn't want to mess with that.

As always, any help is greatly appreciated.

Private Sub CopyCalloff2()
On Error GoTo ErrorMessage
    Dim r As Variant
    Dim ws As Worksheet
    Dim Wst As String
    Dim rw As Long
    Dim rw2 As Long
    Dim col As Integer
    Dim cell As Range
    Dim entrycolum As Long
    Dim Row As Long
    Dim LastRow As Long
    Dim MyCellRow As Long
    Dim wbk1 As Workbook
    Dim wbk2 As Workbook
    Dim wbk3 As Workbook
    Dim wsht1 As Worksheet
    Dim wsht2 As Worksheet
    Dim wsht3 As Worksheet
    Dim wbk2path As String
    Dim wbk3path As String
    Dim response As Integer
    
'warning message
    response = MsgBox("Before running the automation, you must have first copied" & vbCrLf & _
                      "the latest calloff recieved from Fergusons" & vbCrLf & _
                      "If you have not done this, the automation will fail" & vbCrLf & vbCrLf & _
                      "Have you just copied the Calsonic Pivot Table?", vbYesNo + vbCritical + vbDefaultButton2, "Important!!")
        If response = vbYes Then
        
'copy calsonic calloff into this workbook
    Sheets.Add
    Sheets("Sheet1").Range("A1").PasteSpecial
        
'Set paths for developing at home or work
'    wbk2path = "H:\All\Shipping Database\Call_Offs.xlsm"
'    wbk3path = "H:\All\Shipping Database\Interface.xlsm"
    wbk2path = "C:\Users\StevieB\Desktop\Call_Offs.xlsm"
    wbk3path = "C:\Users\StevieB\Desktop\Interface.xlsm"
    
'Stop Screen flicker and speed up macro
Application.ScreenUpdating = False

'copy entire pivot table
    r = ActiveSheet.UsedRange.Value
    
'add values to a new workbook
    Workbooks.Add
    
'clear all forecast rows
    ActiveSheet.Range("a1").Resize(UBound(r, 1), UBound(r, 2)) = r
    Sheets("Sheet2").Range("a1").Resize(UBound(r, 1), UBound(r, 2)) = r
        For rw = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row To 1 Step -1
            If ActiveSheet.Cells(rw, 7) = "Forecast" Then
            ActiveSheet.Cells(rw, 7).EntireRow.Delete
            End If
        Next
        
'clear non-used data
        ActiveSheet.Range("A:C").Delete
        ActiveSheet.Range("C:D").Delete
        
'enter days and dates at the top
With Worksheets("sheet1")
    FinalRow = Sheets("sheet1").Range("A1048576").End(xlUp).Row
    entryrow = FinalRow + 1
    .Range("A" & entryrow).EntireRow.Delete
    .Range("A1").EntireRow.Delete
    .Range("A1").EntireRow.NumberFormat = "ddd"
    .Range("A1").EntireRow.Copy
    .Range("A1").EntireRow.Insert
    .Range("A1").EntireRow.NumberFormat = "ddmm"
    
'clear data too far out into the future
    .Columns("AB:AX").Delete
    
'replace blank spaces in the data with zeros
    .Range("A1").Select
    ActiveCell.CurrentRegion.Replace What:="", Replacement:=0, SearchOrder:=xlByColumns, MatchCase:=True
    
'place the date we recieved the new call off into cells A1 and B1
    .Range("A1:B1").Clear
    .Range("A1").Value = "Rec'd"
    .Range("B1").Value = Date
    .Range("A2").Value = "Pnum"
    .Range("B2").Value = "Code"
    .Range("B1").NumberFormat = "ddmm"
    
'clear data not yet in production
        For Row = .UsedRange.Row + .UsedRange.Rows.Count - 1 To 20 Step -1
            If .Cells(Row, "A") = 0 Then .Rows(Row).Delete
        Next Row
End With

'remove all empty columns
        For col = 30 To 6 Step -1
        Set cell = Cells(3, col)
        If cell.Value = 0 Then
            cell.EntireColumn.Delete
        End If
    Next col
    
'remove firm orders
        For rw2 = Sheets("sheet2").Range("A" & Sheets("Sheet2").Rows.Count).End(xlUp).Row To 1 Step -1
            If Sheets("sheet2").Cells(rw2, 7) = "Firm" Then
            Sheets("sheet2").Cells(rw2, 7).EntireRow.Delete
            End If
        Next
        
'clear non-used data
        Sheets("sheet2").Range("A:C").Delete
        Sheets("sheet2").Range("C:D").Delete
        
'enter days and dates at the top
With Worksheets("sheet2")
    FinalRow = Sheets("sheet2").Range("A1048576").End(xlUp).Row
    entryrow = FinalRow + 1
    .Range("A1").EntireRow.Delete
    .Range("A1").EntireRow.NumberFormat = "ddd"
    .Range("A1").EntireRow.Copy
    .Range("A1").EntireRow.Insert
    .Range("A1").EntireRow.NumberFormat = "ddmmm"
    
'clear data too far out into the future
    .Columns("AB:AX").Delete
    
'place the date we recieved the new call off into cells A1 and B1
    .Range("A1:B1").Clear
    .Range("A1").Value = "Rec'd"
    .Range("B1").Value = Date
    .Range("A2").Value = "Pnum"
    .Range("B2").Value = "Code"
    .Range("B1").NumberFormat = "ddmmm"
End With

'deletes blank columns before the forecast data
' 25 is the column number for Y, 3 for C.
    For col = 25 To 1 Step -1
        Set cell = Sheets("sheet2").Cells(3, col)
        If cell.Value = 0 Then
            cell.EntireColumn.Delete
        End If
    Next col
    
'replace blank spaces in the data block with zeros
    Sheets("sheet2").Range("A1:K40").Replace What:="", Replacement:=0, SearchOrder:=xlByColumns, MatchCase:=True
    
'copy and paste the forcast data at the end of the firm data on sheet1
    Sheets("sheet2").Range("A1").Resize(41, 11).Copy
    Sheets("sheet1").Range("BB1").End(xlToLeft).Offset(0, 1).Select
    ActiveCell.PasteSpecial xlPasteValues
    Sheets("sheet1").Range("A1").Select
    ActiveCell.Copy
    
'copy the consolidated schedule to our CallOff and Interface workbooks
    Set wbk1 = ActiveWorkbook
    Set wsht1 = wbk1.Sheets("Sheet1")
    Set wbk3 = Workbooks.Open(wbk3path)
    Set wsht3 = wbk3.Sheets(1)
    wsht3.Range("A1:AA41").Formula = wsht1.Range("A1:AA41").Value
    wbk3.Save
    wbk3.Close
    Set wbk2 = Workbooks.Open(wbk2path)
    Set wsht2 = wbk2.Sheets(1)
    wsht2.Range("A1:AA41").Formula = wsht1.Range("A1:AA41").Value
    
'Set the focus to our Call_Off workbook
    wsht2.Activate
    
'Update the screen to show our Call_Off workbook
Application.ScreenUpdating = True

'Closing messages
MsgBox "Calsonic Call-Off is now Updated!" & vbCrLf & _
       "Click OK to save and continue.", vbInformation, "Macro developed by S.Byrom"
    Application.ScreenUpdating = False
    For Each ws In ActiveWorkbook.Worksheets
        ws.Select
        ws.Cells(1, 1).Select
    Next
    ActiveWorkbook.Sheets(1).Activate
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    ActiveWorkbook.Close False
MsgBox "All tasks completed!" & vbCrLf & vbCrLf & _
       "Clicking OK will rename the worksheet" & vbCrLf & _
       "with ""Rec"" and todays date" & vbCrLf & _
       "and also Save the Workbook", vbInformation, "Macro developed by S.Byrom"
    Sheets("Sheet1").Name = "Rec" & Format(Date, "ddmmm")
    For Each ws In ActiveWorkbook.Worksheets
        ws.Select
        ws.Cells(1, 1).Select
    Next
    ActiveWorkbook.Save
MsgBox "When working out the next Calsonic loads, do not forget to update" & vbCrLf & _
       "the new call off with any shipping notes that Calsonic did not include!" & vbCrLf & vbCrLf & _
       "This must be done using the Shipping Database via the button" & vbCrLf & _
       """Enter Note into Calsonic Call-Off"" found on the ""Shipping"" tab," & vbCrLf & _
       "where you should enter all note numbers that were not included.", vbCritical + vbExclamation, "Macro developed by S.Byrom"
           Application.Quit
        End If
        Application.ScreenUpdating = True
    If response = vbNo Then
    Exit Sub
    End If
LeaveRoutine:
    Exit Sub
ErrorMessage:
    MsgBox Err.Description, vbCritical, "Please inform S.Byrom of this Error"
    Resume LeaveRoutine
End Sub

Open in new window

0
Stephen Byrom
Asked:
Stephen Byrom
  • 2
  • 2
1 Solution
 
SteveCommented:
For the lines 32-33 try:

Dim ws As Worksheet
Set ws = Worksheets.Add
ws.Name = "Temp"
ws.Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Open in new window


or if you just want values (not the whole pivottable data:
Dim ws As Worksheet
Set ws = Worksheets.Add
ws.Name = "Temp"
ws.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Open in new window

0
 
Stephen ByromAuthor Commented:
Thanks for the response,
I still get the same error though.
I have attached the workbook in question along with the workbook we get sent each week that we copy the pivot table from.
Thanks for your time
Latest-Calsonic.xlsm
Mergon-WK34--2012.xls
0
 
SteveCommented:
I would use the Paste:=xlPasteValues
And create your sheets as named objects...

have started you off in the attached file.
You may wish to change the Sheet1 and sheet2 sheet refs to the new object names

ie change Sheets("Sheet1").xxx to ws1.xxx
Latest-Calsonic.xlsm
0
 
Stephen ByromAuthor Commented:
Thanks so much for your time.
I have tweaked it as you suggested by naming objects to avoid ambiguity, and got it to work as I needed with your help.
Thanks again
0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now