Macro will run correctly in 1 workbook but not another

zookeepertx

Well-known Member
Joined
May 27, 2011
Messages
576
Office Version
  1. 365
Platform
  1. Windows
Hello all,
This is a weird situation! I have a macro that runs correctly on the sheet it was created for. I'm analyzing the coding to make sure I know exactly how it works in case I need to do the same action for something else.
What it does is to take the data sheet, break up the data according to 1 column that shows the Method of delivery, create a new sheet with a pivot table and a pivot chart for each method of delivery.
But when I make a copy of the sheet in a brand new workbook, the code runs but it creates a pivot table and pivot chart that encompass ALL of the data into 1 table and 1 chart.
I've tried running it from the macro menu at the top of the Excel window and directly from the Visual Basic window and the same thing happens either way. (Because I really don't "get" pivot tables and I'm looking at this as an example of creating them.

So, let's call the original workbook "A":
* The macro runs correctly on the sheet in that book
Say I copy that exact sheet into a new workbook - let's call it "B":
* The macro won't work correctly on the sheet
If I copy that same sheet straight from book "B" back into book "A":
* The macro works correctly
If I copy the sheet from book "B" into another new book - let's call it "C":
* The macro doesn't work correctly
I've tried saving "B" and "C" on my desktop as both a "plain" workbook and as a macro-enable workbook and it makes no difference.

So, it seems that it only wants to work correctly in that 1 book.
Anybody got an idea what might be causing such an odd thing?

Thanks!

Jenny
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Hello all,
This is a weird situation! I have a macro that runs correctly on the sheet it was created for. I'm analyzing the coding to make sure I know exactly how it works in case I need to do the same action for something else.
What it does is to take the data sheet, break up the data according to 1 column that shows the Method of delivery, create a new sheet with a pivot table and a pivot chart for each method of delivery.
But when I make a copy of the sheet in a brand new workbook, the code runs but it creates a pivot table and pivot chart that encompass ALL of the data into 1 table and 1 chart.
I've tried running it from the macro menu at the top of the Excel window and directly from the Visual Basic window and the same thing happens either way. (Because I really don't "get" pivot tables and I'm looking at this as an example of creating them.

So, let's call the original workbook "A":
* The macro runs correctly on the sheet in that book
Say I copy that exact sheet into a new workbook - let's call it "B":
* The macro won't work correctly on the sheet
If I copy that same sheet straight from book "B" back into book "A":
* The macro works correctly
If I copy the sheet from book "B" into another new book - let's call it "C":
* The macro doesn't work correctly
I've tried saving "B" and "C" on my desktop as both a "plain" workbook and as a macro-enable workbook and it makes no difference.

So, it seems that it only wants to work correctly in that 1 book.
Anybody got an idea what might be causing such an odd thing?

Thanks!

Jenny
Hey there,
Try posting your code, I am guessing it references the sheet by name or something like that.
 
Upvote 0
I'm pretty sure it doesn't reference a sheet, but I'm not swearing to anything, LOL! Sometimes looking at something too long can make it so you don't see what's in front of you. Maybe you'll see something I'm missing.
It's kinda long though.

VBA Code:
Dim iChartHeight As Integer
Dim iChartWidth As Integer
Dim iChartLeft As Integer

Sub WebDeliveryDate()
'JennyDrumm 06052015

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With

'Sort raw data by Method
lr = Range("A" & Rows.count).End(xlUp).Row
Range("A" & "2" & ":S" & lr).Select
    Selection.Sort Key1:=Range("P1"), Order1:=xlAscending

'Changes Methods to correct abbreviations and delete others
For i = lr To 2 Step -1
    If Range("P" & i).Value = "APP" Then
        Range("P" & i).Value = "USPS"
    ElseIf Range("P" & i).Value = "DD" Then
        Range("P" & i).Value = "2 Day"
    ElseIf Range("P" & i).Value = "FEDXG" Then
        Range("P" & i).Value = "Ground"
    ElseIf Range("P" & i).Value = "FEDXH" Then
        Range("P" & i).Value = "Home Delivery"
    ElseIf Range("P" & i).Value = "ON" Then
        Range("P" & i).Value = "Overnight"
    Else
        Rows(i & ":" & i).EntireRow.Delete
    End If
Next i

'Insert blank row above each section
For lr = Cells(Cells.Rows.count, "P").End(xlUp).Row To 3 Step -1
     If Cells(lr, "P") <> Cells(lr - 1, "P") Then
         Rows(lr).EntireRow.Insert
     End If
Next lr

'Select newly created blank rows
FS = Columns("P").Find(What:=Range("P3").Value, SearchDirection:=xlPrevious).Row
SS = Columns("P").Find(What:=Range("P" & FS + 2), SearchDirection:=xlPrevious).Row
TS = Columns("P").Find(What:=Range("P" & SS + 2), SearchDirection:=xlPrevious).Row
FS2 = Columns("P").Find(What:=Range("P" & TS + 2), SearchDirection:=xlPrevious).Row

'Paste header row in blank rows
With Range("A1:S1")
    .Copy Range("A" & (FS + 1) & ":S" & (FS + 1) & ",A" & (SS + 1) & ":S" & (SS + 1) _
    & ",A" & (TS + 1) & ":S" & (TS + 1) & ",A" & (FS2 + 1) & ":S" & (FS2 + 1))
End With

'Moves on to next subroutine - WorkingPivotTable2
WorkingPivotTable2

Range("N1").Select
ActiveWindow.ScrollRow = 1

'Sets print area
With ActiveSheet.PageSetup
    .LeftMargin = Application.InchesToPoints(0.25)
    .RightMargin = Application.InchesToPoints(0.25)
    .TopMargin = Application.InchesToPoints(0.25)
    .BottomMargin = Application.InchesToPoints(0.25)
    .HeaderMargin = Application.InchesToPoints(0)
    .FooterMargin = Application.InchesToPoints(0)
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
End With

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With

End Sub

Sub WorkingPivotTable2()
    Dim mySheet As Worksheet, pivotSheet As Worksheet
    Dim pc As PivotCache
    Dim pt As PivotTable
    Dim pf1 As PivotField
    Dim pf2 As PivotField
    Dim pf3 As PivotField
    Dim pf4 As PivotField
    Dim mydata As Range
    Dim strFirstRowAddress As String, fromRow As Long, toRow As Long, _
    lastRow As Long, boolRun As Boolean
    Dim oCell As Range
    Dim oPivotPos As Range, strPivotName As String, oldPivotRow As Long, _
    newPivotRow As Long
   
    Set mySheet = ActiveWorkbook.Sheets(1)
    iChartHeight = 150
    iChartWidth = 300
    iChartLeft = 200
   
    'If there is a sheet called Pivot Charts, this deletes it
    On Error Resume Next
    Application.DisplayAlerts = False
    ActiveWorkbook.Sheets("Pivot Charts").Delete
    Err.Clear
    Application.DisplayAlerts = True
    On Error GoTo 0
   
    'Creates a new sheet called Pivot Charts
    Sheets.Add After:=Sheets(1)
    ActiveSheet.Name = "Pivot Charts"
    Set pivotSheet = ActiveWorkbook.Sheets("Pivot Charts")
   
    fromRow = 1
    strFirstRowAddress = mySheet.Range("A1").Address
    lastRow = mySheet.Range("A1").End(xlDown).Row
    boolRun = True
    Set oPivotPos = pivotSheet.Range("A1")
    'Finds the next instance of the word Ticket in column A
    Set oCell = mySheet.Range("A:A").Find(What:="Ticket", LookIn:=xlValues)
    'This tells the macro to continue until it finds a cell in
    'column A that is empty
    While Not oCell Is Nothing And boolRun
        'If next oCell row is not the same as the first one
        'then toRow is the row above oCell
        If oCell.Address <> strFirstRowAddress Then
            toRow = oCell.Row - 1
        Else
            toRow = lastRow
            boolRun = False
        End If
        'Names the Pivot Table "ItemList_(fromRow)_(toRow)"
        '(Pivot Chart will have the same name)
        strPivotName = "ItemList_" & fromRow & "_" & toRow
        'Selects the data on the source sheet and creates the basic Table
        Set mydata = mySheet.Range("A" & fromRow & ":S" & toRow)
        Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, mydata)
        Set pt = pc.CreatePivotTable(oPivotPos, strPivotName)
        'Sets up rows and data fields in table
        Set pf1 = pt.PivotFields("Method")
            pf1.Orientation = xlRowField
        Set pf2 = pt.PivotFields("OutofRange")
            pf2.Orientation = xlRowField
        Set pf3 = pt.PivotFields("Tracking#")
            pf3.Orientation = xlDataField
            pf3.Function = xlCount
            pf3.Caption = "Count"
        Set pf4 = pt.PivotFields("Tracking#")
            pf4.Orientation = xlDataField
            pf4.Function = xlCount
            pf4.Caption = "% of Method"
            pf4.Calculation = xlPercentOfTotal
            pf4.NumberFormat = "0.00%"
       
        'Moves on to the next subroutine - CreatePivotChart2
        CreatePivotChart2 pt.TableRange1, "Chart_" & fromRow & "_" & toRow
       
        'Chooses the position for the next pivot table
        oldPivotRow = oPivotPos.Row
        'Sets the new Pivot table to be placed 4 rows
        'below the end of the previous table
        newPivotRow = pt.DataLabelRange.End(xlDown).Row + 4
        'But, if the newPivotRow is above the end of the previous chart
        'then the newPivotRow will be placed 2 rows below the previous chart
        If ((newPivotRow - oldPivotRow) < (iChartHeight / _
        pivotSheet.StandardHeight)) Then
            newPivotRow = oldPivotRow + Round(iChartHeight / _
            pivotSheet.StandardHeight) + 2
        End If
        'Sets oPivotPos as A in the newPivotRow
        Set oPivotPos = pivotSheet.Range("A" & newPivotRow)
        'Sets fromRow as previous toRow + 1
        fromRow = toRow + 1
        'Sets oCell to next row where A is Ticket
        Set oCell = mySheet.Range("A:A").FindNext(oCell)
    Wend
   
    'Sets all charts with their left borders aligned.
    For Each oCht In pivotSheet.ChartObjects
        oCht.Left = 200
    Next oCht
   
'Macro then goes back to sub WebDeliveryDate at the point it left
End Sub

Sub CreatePivotChart2(chartData As Range, chartName As String)
    Dim chObj As ChartObject
    Dim ch As Chart
   
    Set mySheet = ActiveWorkbook.Sheets("Pivot Charts")
    'Each time a new chart is created, if there's already a chart
    'with that name, delete the old one
    For Each oCht In mySheet.ChartObjects
        If oCht.Name = chartName Then oCht.Delete
    Next oCht
    'Selects data in the Pivot Table to use in the Pivot Chart
    chartData.Select
    'Formats new Chart
    Set chObj = mySheet.ChartObjects.Add(iChartLeft, chartData.Top + 1, _
    iChartWidth + 148, iChartHeight)
    chObj.Chart.ChartWizard Source:=chartData, gallery:=xlColumnClustered
    chObj.Name = chartName
    'Changes the % bars to a line and then makes that line invisible
    chObj.Chart.SeriesCollection(2).ChartType = xlLine
    chObj.Chart.SeriesCollection(2).Select
    Selection.Format.Line.Visible = msoFalse
    'Gets rid of the % button in the Legend
    chObj.Chart.Legend.LegendEntries(2).Delete
   
'Macro then goes back to sub WorkingPivotTable at the point it left
End Sub

Thanks for looking at it.
 
Upvote 0
I see part of your code references ;
Sheets.Add After:=Sheets(1)
When you copy the sheet to a new workbook, what is the name of the sheet then? If you right click on the copied sheet, and click view code, is your code present there?
 
Upvote 0
I was pretty sure that "Sheets(1)" simply meant the first sheet in the workbook, regardless of what that sheet is named. Is that not the case? This macro does consistently add that sheet immediately after the first sheet in the workbook.
 
Upvote 0
Well, CRUD! Now I've tried messing with it in different sheets/workbooks and now it doesn't even work right on the original workbook! :mad: I broke it!
 
Upvote 0

Forum statistics

Threads
1,215,078
Messages
6,122,996
Members
449,093
Latest member
masterms

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top