GeMa
GeMa

Reputation: 149

VBA code to automatic produce charts in excel

I am trying to write a vba code in excel to produce automatic plots of many groups of data.

I have tried the following script but I am facing the difficulty of iterating throug the columns (x-axis, y-ayis of the plot/chart).

The first par of the code is copied from another tag from here and is supposed to give the relation between the column number and name (i.e. Column number 33 = AG).

My questions are:

  1. It is better to pick the region and apply the macro or to write the macro for the exact field of interest
  2. Have anyone an idea how can iterate through the columns/ groups?

An example of my data-set (here only 3 groups are presented; the first column is the y-axis, the first row is the titles of the legend, the next 13 columns are the x-axes):

    dw=0,01 dw=0,1  dw=1    dw=2    dw=3    dw=4    dw=5    dw=6    dw=8    dw=10   dw=20   dw=30   dw=40
0,0 0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000
0,1 0,4011  0,4057  0,4465  0,4827  0,5119  0,5359  0,5561  0,5732  0,6006  0,6215  0,6786  0,7027  0,7146
0,2 0,5523  0,5553  0,5810  0,6029  0,6199  0,6332  0,6438  0,6522  0,6643  0,6720  0,6796  0,6682  0,6519
0,3 0,6290  0,6286  0,6245  0,6195  0,6143  0,6089  0,6035  0,5980  0,5870  0,5762  0,5256  0,4818  0,4440
0,4 0,6726  0,6689  0,6351  0,6038  0,5774  0,5546  0,5347  0,5169  0,4862  0,4605  0,3705  0,3114  0,2672
0,5 0,6843  0,6778  0,6199  0,5677  0,5248  0,4887  0,4578  0,4310  0,3866  0,3511  0,2403  0,1787  0,1375
0,6 0,6656  0,6574  0,5840  0,5185  0,4653  0,4211  0,3839  0,3520  0,3002  0,2599  0,1432  0,0862  0,0520
0,7 0,6135  0,6045  0,5256  0,4556  0,3991  0,3526  0,3137  0,2806  0,2276  0,1871  0,0757  0,0267  0,0014
0,8 0,5220  0,5137  0,4400  0,3750  0,3227  0,2798  0,2441  0,2139  0,1660  0,1297  0,0333  0,0060  0,0252
0,9 0,3632  0,3571  0,3033  0,2559  0,2178  0,1867  0,1609  0,1391  0,1046  0,0787  0,0113  0,0145  0,0266
1,0 0,2435  0,2393  0,2026  0,1703  0,1443  0,1232  0,1056  0,0908  0,0674  0,0499  0,0046  0,0121  0,0198

    dw=0,01 dw=0,1  dw=1    dw=2    dw=3    dw=4    dw=5    dw=6    dw=8    dw=10   dw=20   dw=30   dw=40
0,0 0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000
0,1 0,3015  0,3059  0,3454  0,3820  0,4126  0,4386  0,4610  0,4804  0,5124  0,5378  0,6116  0,6464  0,6656
0,2 0,4161  0,4195  0,4497  0,4771  0,4994  0,5178  0,5331  0,5460  0,5661  0,5808  0,6118  0,6140  0,6066
0,3 0,4742  0,4751  0,4831  0,4896  0,4940  0,4969  0,4986  0,4995  0,4990  0,4967  0,4720  0,4417  0,4122
0,4 0,5074  0,5058  0,4911  0,4765  0,4635  0,4516  0,4406  0,4304  0,4120  0,3956  0,3314  0,2842  0,2469
0,5 0,5165  0,5128  0,4792  0,4475  0,4204  0,3969  0,3761  0,3577  0,3262  0,3001  0,2134  0,1616  0,1256
0,6 0,5026  0,4975  0,4513  0,4083  0,3721  0,3412  0,3144  0,2910  0,2520  0,2207  0,1254  0,0761  0,0457
0,7 0,4634  0,4577  0,4061  0,3585  0,3188  0,2851  0,2562  0,2312  0,1900  0,1577  0,0645  0,0214  0,0034
0,8 0,3945  0,3890  0,3400  0,2949  0,2574  0,2258  0,1989  0,1757  0,1378  0,1084  0,0267  0,0084  0,0260
0,9 0,2746  0,2705  0,2344  0,2012  0,1737  0,1506  0,1309  0,1140  0,0866  0,0654  0,0077  0,0154  0,0266
1,0 0,1841  0,1814  0,1566  0,1339  0,1151  0,0993  0,0859  0,0744  0,0557  0,0413  0,0025  0,0125  0,0197

    dw=0,01 dw=0,1  dw=1    dw=2    dw=3    dw=4    dw=5    dw=6    dw=8    dw=10   dw=20   dw=30   dw=40
0,0 0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000  0,0000
0,1 0,0851  0,0873  0,1081  0,1293  0,1487  0,1665  0,1830  0,1983  0,2257  0,2497  0,3356  0,3891  0,4260
0,2 0,1198  0,1218  0,1414  0,1611  0,1789  0,1950  0,2098  0,2232  0,2468  0,2669  0,3325  0,3664  0,3849
0,3 0,1375  0,1388  0,1511  0,1633  0,1742  0,1838  0,1924  0,2000  0,2129  0,2233  0,2512  0,2584  0,2566
0,4 0,1480  0,1485  0,1529  0,1571  0,1606  0,1635  0,1659  0,1678  0,1706  0,1723  0,1701  0,1600  0,1475
0,5 0,1514  0,1512  0,1486  0,1458  0,1430  0,1403  0,1376  0,1350  0,1298  0,1248  0,1023  0,0834  0,0675
0,6 0,1480  0,1472  0,1396  0,1317  0,1245  0,1178  0,1116  0,1058  0,0954  0,0862  0,0523  0,0303  0,0148
0,7 0,1370  0,1359  0,1254  0,1148  0,1052  0,0964  0,0883  0,0809  0,0679  0,0567  0,0186  0,0037  0,0169
0,8 0,1171  0,1159  0,1050  0,0940  0,0841  0,0751  0,0669  0,0595  0,0464  0,0353  0,0011  0,0195  0,0302
0,9 0,0817  0,0809  0,0724  0,0640  0,0564  0,0496  0,0434  0,0377  0,0279  0,0196  0,0064  0,0196  0,0268
1,0 0,0550  0,0543  0,0485  0,0426  0,0374  0,0326  0,0283  0,0244  0,0176  0,0119  0,0056  0,0145  0,0192

And here is the code as it seems right now:

Sub Makro3()
'
' Makro3 Makro
'The next lines give the column number to iterate for:
    Dim i&, k&, j&
    Dim d As Integer
    Dim m As Integer
    Dim name As String
    d = colNum
    name = ""
    Do While (d > 0)
        m = (d - 1) Mod 26
        name = Chr(65 + m) + name
        d = Int((d - m) / 26)
    Loop
    GetColumnName = name
' The next lines should give the chart commants:
For i = 1 To 20
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveSheet.Shapes("Diagramm ""i"").IncrementLeft 445.9090551181
    'here the next chart should be designed below the prior chart
    ActiveSheet.Shapes("Diagramm ""i"").IncrementTop i * 10  
    ActiveChart.ApplyLayout (1)
    ' iterate through the columns for each group of series
    For k = 1 To 13
    ActiveChart.SeriesCollection.NewSeries
    ' the name of the column i.e. AH69
    ActiveChart.SeriesCollection(k).Name = "=linear!$AH$68"
    ' the x-axis changes with increasing column number
    ActiveChart.SeriesCollection(k).XValues = "=linear!$AH$69:$AH$79"
    ' the y-axis changes with increasing group set
    ActiveChart.SeriesCollection(k).Values = "=linear!$AG$69:$AG$79"
    Next k
    ' script lines to define the format of the chart, axes, etc...
    With
    ......
    End With
    ActiveChart.Axes(xlCategory).AxisTitle.Select
Next i
End Sub

With this script I am expecting 3 charts, with 13 curves each. Any help is appreciated.

Upvotes: 0

Views: 1316

Answers (1)

Scott Holtzman
Scott Holtzman

Reputation: 27239

I think this could be a lot simpler than the way you are going about it. See the code below, based on the example data you gave.

I made the following assumptions:

  1. Data starts in cell A1
  2. Sheet name is "Sheet1"
  3. Data set is exactly as provided (with one line space between each set

From these assumptions you can change all counting and sheet/range references to your exact needs.

Sub MakeCharts()

Dim ws As Worksheet
Set ws = Sheets("Sheet1")

Dim x As Integer

For x = 1 To 38 Step 13

    ws.Shapes.AddChart.Select

    With ActiveChart

        .ChartType = xlXYScatterSmoothNoMarkers

        Dim k As Integer

        For k = 1 To 13

            .SeriesCollection.NewSeries
            .SeriesCollection(k).Name = ws.Cells(x, k + 1)
            .SeriesCollection(k).XValues = ws.Range(ws.Cells(x + 1, k + 1), ws.Cells(x + 11, k + 1))
            .SeriesCollection(k).Values = ws.Range(ws.Cells(x + 1, 1), ws.Cells(x + 11, 1))

        Next

        .ApplyLayout (1)

        Dim sName As String
        sName = Replace(.Name, ws.Name & " ", "")

    End With

    With ActiveSheet.Shapes(sName)
        .IncrementLeft 445.9090551181
        .IncrementTop x * 10
    End With

Next

End Sub

Upvotes: 1

Related Questions