Macro to create diagrams from a table with 89 columns

M

MartinIsAsking

New member
Joined
Jan 20, 2015
Messages
7
Reaction score
0
Points
0
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!
 
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 :croc:.

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 a moderator:
In any case, thanks a lot for the help. I am a full beginner when it comes to VBA programming! :-(
 
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
 
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?
 
Hier der Link.


Ich habe eine Deutsche 2007 Excel Version. Das Makro bugt noch...Vielen Dank auf alle Fälle!!!!!
 
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 a moderator:
You must log in or register to reply here.
Back
Top