Results 1 to 10 of 10

Thread: Macro to create diagrams from a table with 89 columns

  1. #1

    Macro to create diagrams from a table with 89 columns



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Dear All

    I have a table with data from a wastewater treatment plant. The table contains 89 columns. Column A is the day/date. The rest of the columns are measurements parameters from Column B till Column CH.

    I would like to create a makro which create an x-y dot plot with X-axis always Column A (date) and the Y-axis the other parameters. In the end I should have 88 plots where each plot shows me the graph of one parameters vs. the date.

    Unfortunately, I am not able to tell VBA to move forward by one column. I can only record the creation of one plot but then the makro will always use the same column and not move on! Can anybody help me by providing the code for such a makro? Thank you very much in advance!

  2. #2
    Conjurer snb's Avatar
    Join Date
    May 2013
    Posts
    374
    Articles
    0
    Excel Version
    2020
    If you provide the macro you recorded...

  3. #3
    Below the code. Not sure if it is of any use. This one will just repeatedly create a diagram with column D, E and F. I am sure, it is quite wrong .

    Code:
    Sub Test()
    Dim lAnzahl As String
    Dim i As Long
    Anf:
    lAnzahl = InputBox("Wie oft soll das Makro laufen ?", , 3)
    
    If lAnzahl = "" Then Exit Sub
    
    'Prüfen ob eine Zahl eingegeben wurde
    If IsNumeric(lAnzahl) Then
    For i = 1 To CLng(lAnzahl)
    ActiveSheet.ChartObjects("Diagramm 4").Activate
        ActiveSheet.ChartObjects("Diagramm 4").Activate
        ActiveChart.ChartArea.Copy
        ActiveWindow.SmallScroll Down:=12
        Range("A29").Select
        ActiveSheet.Paste
        ActiveWindow.SmallScroll Down:=3
        ActiveSheet.ChartObjects("Diagramm 7").Activate
        ActiveChart.SeriesCollection(1).Values = "='2014'!$D$2:$D$366"
        ActiveChart.SeriesCollection(1).Name = "='2014'!$D$1"
        ActiveChart.ChartArea.Copy
        Range("K29").Select
        ActiveSheet.Paste
        ActiveSheet.ChartObjects("Diagramm 8").Activate
        ActiveChart.PlotArea.Select
        ActiveChart.SeriesCollection(1).Values = "='2014'!$E$2:$E$366"
        ActiveChart.SeriesCollection(1).Name = "='2014'!$E$1"
        ActiveSheet.ChartObjects("Diagramm 8").Activate
        ActiveChart.ChartArea.Select
        ActiveChart.ChartArea.Copy
        ActiveWindow.SmallScroll Down:=15
        Range("A52").Select
        ActiveSheet.Paste
        ActiveWindow.SmallScroll Down:=3
        ActiveSheet.ChartObjects("Diagramm 9").Activate
        ActiveChart.SeriesCollection(1).Values = "='2014'!$F$2:$F$366"
        ActiveChart.SeriesCollection(1).Name = "='2014'!$F$1"
    MsgBox "Makro Start Nr.: " & i
    Next i
    Else
    MsgBox "Bitte ein Zahl eingeben !", vbInformation
    GoTo Anf
    End If
    
    End Sub
    Last edited by Bob Phillips; 2015-01-22 at 11:28 AM. Reason: Added code tags

  4. #4
    In any case, thanks a lot for the help. I am a full beginner when it comes to VBA programming! :-(

  5. #5
    Conjurer snb's Avatar
    Join Date
    May 2013
    Posts
    374
    Articles
    0
    Excel Version
    2020
    Code:
    Sub M_snb()
       with ActiveSheet.ChartObjects("Diagramm 4").ChartArea
         for j=1 to 20
            with .SeriesCollections.add
              .Values = "='2014'!" & sheets("2014").range("C2:C366").offset(,j).address
              .Name = "='2014'!" & sheets("2014").range("C1").offset(,j).address
            end with
         next
       end with
    End Sub

  6. #6
    Thanks a lot. Mmmmh, it does not like:

    with ActiveSheet.ChartObjects("Diagramm 4").ChartArea

    I changed it to: with ActiveSheet.ChartObjects("Diagramm 1").ChartArea

    Still, altough there is a Diagramm 1 it doesn't work...shall I provide a part of the excel sheet? would that be easier?

  7. #7
    Conjurer snb's Avatar
    Join Date
    May 2013
    Posts
    374
    Articles
    0
    Excel Version
    2020
    Genau, viel besser.

  8. #8
    Hier der Link.


    Ich habe eine Deutsche 2007 Excel Version. Das Makro bugt noch...Vielen Dank auf alle Fälle!!!!!

  9. #9

  10. #10
    The code below worked for me!! Excel Version 2007 in German. Thanks!

    Code:
    Sub Test()
        Dim LastRow As Long
        Dim LastCol As Long
        Dim r As Long
        Dim c As Long
        Dim i As Long
        With Worksheets("2012-2014")
            LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
            LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        End With
        r = 1
        c = 1
        Worksheets.Add
        With ActiveSheet
            For i = 2 To LastCol
                .Shapes.AddChart.Select
                With ActiveChart
                    .ChartType = xlXYScatter
                    .SeriesCollection.NewSeries
                    .SeriesCollection(1).Name = "='2012-2014'!" & Cells(1, i).Address
                    .SeriesCollection(1).XValues = "='2012-2014'!R2C1:R" & LastRow & "C1"
                    .SeriesCollection(1).Values = "='2012-2014'!R2C" & i & ":R" & LastRow & "C" & i
                End With
                ActiveChart.Parent.Top = .Cells(r, c).Top
                ActiveChart.Parent.Left = .Cells(r, c).Left
                If c = 1 Then
                    c = c + 8
                Else
                    c = 1
                    r = r + 15
                End If
            Next i
        End With
    End Sub
    Last edited by Bob Phillips; 2015-01-22 at 11:27 AM. Reason: Added code tags

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •