none
Copy and Align Charts on a new sheet RRS feed

  • Question

  • Hi All,


    This is my first steps on VBA in Excel 2010 and I face a bit of a challenge, I hope someone will be able to help. I am treating data concerning different factories having different production lines. Per factory, I am displaying 33 pivots charts next to their respective Pivot tables, each one with a specific production line filter on the same source data (just like the Page field report but on a single worksheet).

    As all the factories do not have the same number of lines and I need to

    be able to display everything just by changing my slicers, I keep all 33 PivotCharts open and they are filled only if the line (hence the Pivot Table) exist for the Factory and data are entered.

    Per factory, I need to be able to select the charts that do have data, copy them to another sheet and align them in order to be printable.

    Here is the code I came up with by adding internet sources; I
    think I am not that fare but I struggle with the last steps:

    Sub CopyAndAlignCharts()
        Dim iChart As Long
        Dim nCharts As Long
        Dim dTop As Double
        Dim dLeft As Double
        Dim dHeight As Double
        Dim dWidth As Double
        Dim nColumns As Long
        dTop = 75      ' top of first row of charts
        dLeft = 100    ' left of first column of charts
        dHeight = 225  ' height of all charts
        dWidth = 375   ' width of all charts
        nColumns = 3   ' number of columns of charts
        nCharts = ActiveSheet.ChartObjects.Count
       For iChart = 1 To nCharts
     Do While Workshets("FAC&Graph").ChartObjects(iChart).SeriesCollection(1).Values <> ""
            ActiveChart.ChartArea.Copy
            Worksheets("Sheet1").Paste
       Loop
       Next
       For iChart = 1 To nCharts
               With Worksheets("Sheet1").ChartObjects(iChart)
                .Height = dHeight
                .Width = dWidth
                .Top = dTop + Int((iChart - 1) / nColumns) * dHeight
                .Left = dLeft + ((iChart - 1) Mod nColumns) * dWidth
            End With
    Next
    End Sub

    If someone sees anything that might help me, I would be very
    grateful.


    Monday, August 4, 2014 2:50 PM

All replies

  • Not sure if the following is what you are looking for but give it a try and feel free to get back to me. I have assumed that you are copying the charts from a worksheet named "FAC&Graph" to a worksheet named "Sheet1". I hope I have interpreted that correctly otherwise the code will probably not do what you want.

    Correctly Dimensioning object variables and assigning the objects to the variables results in the VBA intellisence kicking in and helping with the syntax for the code.

    Code has been edited since initial posting.

    Sub CopyAndAlignCharts()
        Dim iChart As Long
        Dim nCharts As Long
        Dim dTop As Double
        Dim dLeft As Double
        Dim dHeight As Double
        Dim dWidth As Double
        Dim nColumns As Long
        Dim myChart As ChartObject  '<---*** Added by OssieMac
        dTop = 75      ' top of first row of charts
        dLeft = 100    ' left of first column of charts
        dHeight = 225  ' height of all charts
        dWidth = 375   ' width of all charts
        nColumns = 3   ' number of columns of charts
       
        nCharts = Worksheets("FAC&Graph").ChartObjects.Count    'Edited by OssieMac
       
        For iChart = 1 To nCharts
            Set myChart = Worksheets("FAC&Graph").ChartObjects(iChart)  '<---*** Added by OsieMac
            If Not myChart.Chart.SeriesCollection(1) Is Nothing Then
                myChart.Copy
                Worksheets("Sheet1").Paste
            End If
        Next
       
        'Next line needs to be prior to the loop otherwise the loop
        'is working with the incorrect worksheet.
        With Worksheets("Sheet1")
            'Next line required because if not all charts copied
            'then the number of charts will be different from source sheet.
            nCharts = .ChartObjects.Count
            For iChart = 1 To nCharts
                With .ChartObjects(iChart)
                    .Height = dHeight
                    .Width = dWidth
                    .Top = dTop + Int((iChart - 1) / nColumns) * dHeight
                    .Left = dLeft + ((iChart - 1) Mod nColumns) * dWidth
                End With
            Next iChart
        End With
    End Sub


    Regards, OssieMac


    • Edited by OssieMac Wednesday, August 6, 2014 2:17 AM
    Wednesday, August 6, 2014 2:08 AM
  • Note that the code has been edited in my previous post to ensure that the sizing of the charts section is all referencing the correct worksheet. See my comments in the code.

    Regards, OssieMac

    Wednesday, August 6, 2014 2:19 AM
  • Hi OssieMac,

    Thanks for your answer.

    I don't know if it works for you, it doesn't seem to recognise the mychart. Excel copies the two first charts and then send me to debug.

    What I did instead was forgetting the loop for the selection and copy component, keeping it only for the alignment.

    It is, for sure, less elegant and was a pain to write but it works fine. here it is

    Sub CopyAndAlignFACGraphinSheet1()
    '
    ' Macro1 Macro
    'The following code copies all PivotChart from "FAC&Graph" iff hey do feature values
    '(check cells are D-for the first colomn, O for the second and AA for the third)
    
    If Worksheets("FAC&Graph").Range("D9").Value <> "" Then
        ActiveSheet.ChartObjects("Chart 1").Activate
        ActiveChart.ChartArea.Copy
        Sheets("Sheet1").Select
        Range("A2").Select
        ActiveSheet.Paste
        End If
        
    If Worksheets("FAC&Graph").Range("O9").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 2").Activate
        ActiveChart.ChartArea.Copy
        Sheets("Sheet1").Select
        Range("J2").Select
        ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("AA9").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 3").Activate
        ActiveChart.ChartArea.Copy
        Sheets("Sheet1").Select
        Range("T2").Select
        ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("D31").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 4").Activate
        ActiveChart.ChartArea.Copy
        Sheets("Sheet1").Select
        Range("A20").Select
        ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("O31").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 5").Activate
        ActiveChart.ChartArea.Copy
        Sheets("Sheet1").Select
        Range("J20").Select
        ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("AA31").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 6").Activate
        ActiveChart.ChartArea.Copy
        Sheets("Sheet1").Select
        Range("T20").Select
        ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("D52").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 7").Activate
        ActiveChart.ChartArea.Copy
            Sheets("Sheet1").Select
        Range("A40").Select
        ActiveSheet.Paste
        End If
    
        If Worksheets("FAC&Graph").Range("O52").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 8").Activate
        ActiveChart.ChartArea.Copy
            Sheets("Sheet1").Select
        Range("J40").Select
        ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("AA52").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 9").Activate
        ActiveChart.ChartArea.Copy
            Sheets("Sheet1").Select
            Range("T40").Select
            ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("D73").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 10").Activate
        ActiveChart.ChartArea.Copy
            Sheets("Sheet1").Select
            Range("A60").Select
            ActiveSheet.Paste
        End If
           
        If Worksheets("FAC&Graph").Range("O73").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 11").Activate
        ActiveChart.ChartArea.Copy
        Sheets("Sheet1").Select
        Range("J60").Select
        ActiveSheet.Paste
       End If
       
        If Worksheets("FAC&Graph").Range("AA73").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 12").Activate
        ActiveChart.ChartArea.Copy
        Sheets("Sheet1").Select
        Range("T60").Select
        ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("D94").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 13").Activate
        ActiveChart.ChartArea.Copy
            Sheets("Sheet1").Select
            Range("A80").Select
            ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("O94").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 14").Activate
        ActiveChart.ChartArea.Copy
            Sheets("Sheet1").Select
            Range("J80").Select
            ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("AA94").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 15").Activate
        ActiveChart.ChartArea.Copy
            Sheets("Sheet1").Select
            Range("T80").Select
            ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("D115").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 16").Activate
        ActiveChart.ChartArea.Copy
            Sheets("Sheet1").Select
            Range("A100").Select
            ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("O115").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 17").Activate
        ActiveChart.ChartArea.Copy
            Sheets("Sheet1").Select
            Range("J100").Select
            ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("AA115").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 18").Activate
        ActiveChart.ChartArea.Copy
            Sheets("Sheet1").Select
            Range("T100").Select
            ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("D136").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 19").Activate
        ActiveChart.ChartArea.Copy
            Sheets("Sheet1").Select
            Range("A120").Select
            ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("O136").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 20").Activate
        ActiveChart.ChartArea.Copy
            Sheets("Sheet1").Select
            Range("J120").Select
            ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("AA136").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 21").Activate
        ActiveChart.ChartArea.Copy
            Sheets("Sheet1").Select
            Range("T120").Select
            ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("D157").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 22").Activate
        ActiveChart.ChartArea.Copy
            Sheets("Sheet1").Select
            Range("A140").Select
            ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("O157").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 23").Activate
        ActiveChart.ChartArea.Copy
            Sheets("Sheet1").Select
            Range("J140").Select
            ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("AA157").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 24").Activate
        ActiveChart.ChartArea.Copy
            Sheets("Sheet1").Select
            Range("T140").Select
            ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("D178").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 25").Activate
        ActiveChart.ChartArea.Copy
        Sheets("Sheet1").Select
        Range("A160").Select
        ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("O178").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 26").Activate
        ActiveChart.ChartArea.Copy
        Sheets("Sheet1").Select
        Range("J160").Select
        ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("AA178").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 27").Activate
        ActiveChart.ChartArea.Copy
        Sheets("Sheet1").Select
        Range("T160").Select
        ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("D199").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 28").Activate
        ActiveChart.ChartArea.Copy
        Sheets("Sheet1").Select
        Range("A180").Select
        ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("O199").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 29").Activate
        ActiveChart.ChartArea.Copy
        Sheets("Sheet1").Select
        Range("J180").Select
        ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("AA199").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 30").Activate
        ActiveChart.ChartArea.Copy
        Sheets("Sheet1").Select
        Range("T180").Select
        ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("D220").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 31").Activate
        ActiveChart.ChartArea.Copy
        Sheets("Sheet1").Select
        Range("A200").Select
        ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("O220").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 32").Activate
        ActiveChart.ChartArea.Copy
        Sheets("Sheet1").Select
        Range("J200").Select
        ActiveSheet.Paste
        End If
        
        If Worksheets("FAC&Graph").Range("AA220").Value <> "" Then
        Sheets("FAC&Graph").Select
        ActiveSheet.ChartObjects("Chart 33").Activate
        ActiveChart.ChartArea.Copy
        Sheets("Sheet1").Select
        Range("T200").Select
        ActiveSheet.Paste
        End If
        
    'The following component of the code will take the charts that have been copied in "Sheet1"
    'and align them on cell A1.
    
        Dim iChart As Long
        Dim nCharts As Long
        Dim dTop As Double
        Dim dLeft As Double
        Dim dHeight As Double
        Dim dWidth As Double
        Dim nColumns As Long
    
        dTop = 1      ' top of first row of charts
        dLeft = 1    ' left of first column of charts
        dHeight = 225  ' height of all charts
        dWidth = 375   ' width of all charts
        nColumns = 3   ' number of columns of charts
        nCharts = Worksheets("Sheet1").ChartObjects.Count
    
       For iChart = 1 To nCharts
               With Worksheets("Sheet1").ChartObjects(iChart)
                .Height = dHeight
                .Width = dWidth
                .Top = dTop + Int((iChart - 1) / nColumns) * dHeight
                .Left = dLeft + ((iChart - 1) Mod nColumns) * dWidth
            End With
    Next
    
        
    End Sub
    

    Tell me if you see anything simplier.

    Thanks for your help and time anyhow.

    Regards

    QuentinSa

    Wednesday, August 6, 2014 12:37 PM
  • I don't know if it works for you, it doesn't seem to recognise the mychart. Excel copies the two first charts and then send me to debug.

    Hello again QuentinSa,

    The code worked in the test that I set up but obviously my example is not the same as yours. I have found an error in my logic in the test for the series 1 if it does not exist but I can fix that.

    In the following line can you tell me what it signifies if Range("D9"). is not equal to ""

    If Worksheets("FAC&Graph").Range("D9").Value <> "" Then

    Does it mean that there are no values or no series 1 in the chart so don't copy. Or what other reason that the value must not be a null string. Without this knowledge I cannot create the loop because the range is different for each workbook. I can test the chart to see if it has a series 1 plus I can test each point in the series 1 to see if it has a value and if either no series (or no points have values) then don't include it if this is what you are looking for.

    Do you have any sensitive data that you cannot share or can you  post a copy of the workbook on OneDrive? If you can simply copy the required worksheets with the charts (and the data for the charts) to another workbook will do.

    Not sure of your expertise so following are guidelines to copy the worksheet to a new workbook and post the workbook on OneDrive. Even if you know how to copy the worksheet please refer to step 6 re Copy -> PasteSpecial -> Values.

    To copy the sheet with the charts and/or data use the following method.

    1. Right click the sheet tab name
    2. Select Move or Copy
    3. In the dropdown select New book
    4. Check the box against Copy.
    5. Click OK and now the new workbook will be the ActiveWorkbook
    6. Select all of the cells on the worksheet and then Copy -> PasteSpecial -> Values. (This is required so that it is not attempting to reference cells on the original workbook which I won't have access to and that will cause the cells to error)
    7. Save the new workbook to name of choice.

    To post a workbook on OneDrive:

    1. Zip your workbook. I prefer that you do not just save to OneDrive. (To Zip a file: In Windows Explorer  Right click on the selected file and select Send to -> Compressed (zipped) folder.)
    2. Go to this link.  https://onedrive.live.com
    3. Use the same login Id and Password that you use for this forum.
    4. Select Upload in the blue bar across the top and browse to the zipped folder to be uploaded and select Open (or just double click). (Be patient and give it time to display the file after initially seeing the popup indicating it is done.)
    5. Right click the file on OneDrive and select Share.
    6. Do NOT fill in the form; "Select Get a Link" on the left side.
    7. Click the button "Create a Link"
    8. Click in the box where the link is created and it will highlight.
    9. Copy the link and paste into your reply on this forum.

    Regards, OssieMac

    Thursday, August 7, 2014 1:23 AM