Repetitive graphing macro?

[Lou38]

I'm a macro newbie so I would be enormously grateful if anyone could help me solve this problem (I've tried searching various forums but not been able to adapt advice to my specific problem)

I have a worksheet with various datasets in columns which I want to plot onto a series of simple line charts. Each series represents one set of readings at 14 different frequencies, and anything from 1 to 4 readings are obtained from each subject at a particular time (as shown by the ID and date rows).

I can make the charts individually by selecting each set of columns one by one, but my dataset is very large (and increasing!) so if there's a way of doing this automatically it will save me a HUGE amount of time.

I can't seem to paste the worksheet or a screenshot of it to illustrate but can do so if helpful (and someone can explain how to! )
Thanks in advance for any help..

 

[pdevito3]

Crap that's still wrong... sorry lou gimmi a minute

 

[pdevito3]

Finally got it... wow. This should do it:

Option Explicit
Sub lotsOfGraphs()
'efficiency
    Application.ScreenUpdating = False
' variables
    Dim ct                      As ChartObject
    Dim chartName               As String       ' name of chart
    Dim chartNum                As Integer      ' number of chart for name
    Dim trackLeft               As Double       ' tracks the placement of the left side of each graph
    Dim trackTop                As Double       ' tracks the placement of the top side of each graph
    Dim axisRg                  As String       ' range of data with the axis info
    Dim lastCol                 As Integer      ' last column of data
    Dim colHelper               As String       ' helper for do loop
    Dim colCounter              As Integer      ' helper for do loop
    Dim startCol                As Integer      ' tracks start col of new graph
    Dim endCol                  As Integer      ' tracks end col of new graph
    
    chartNum = 1
    trackLeft = -322.5
    trackTop = 166.5
    axisRg = "$A$1:$A$" & Cells(Rows.Count, "A").End(xlUp).Row
    lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    startCol = 2
    
' remove old charts
    For Each ct In ActiveSheet.ChartObjects
        ct.Delete
    Next ct
    
' add new charts
    ' loop through columns
        Do While endCol <= lastCol
            endCol = startCol
            ' loop through columns to see how many to use
                colHelper = "1"
                Do While colHelper = "1"
                    If Cells(1, endCol).Value = Cells(1, endCol + 1).Value Then
                        endCol = endCol + 1
                    Else
                        colHelper = 0
                    End If
                Loop
            ' add chart
                chartName = "Chart " & chartNum
                Range(axisRg & ",$" & pCTL(startCol) & "$1:$" & pCTL(endCol) & "$" & _
                    Cells(Rows.Count, endCol).End(xlUp).Row).Select
                ActiveSheet.Shapes.AddChart.Select
                ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
                ActiveChart.SetSourceData Source:=Range(axisRg & ",$" & pCTL(startCol) & "$1:$" & pCTL(endCol) & "$" & _
                    Cells(Rows.Count, endCol).End(xlUp).Row)
                ActiveChart.Parent.Name = chartName
                ActiveSheet.Shapes(ActiveChart.Parent.Name).IncrementLeft trackLeft
                ActiveSheet.Shapes(ActiveChart.Parent.Name).IncrementTop trackTop
            'setup next chart info
                chartNum = chartNum + 1
                trackLeft = trackLeft + ActiveSheet.Shapes(ActiveChart.Parent.Name).Width + 20
                startCol = endCol + 1
                endCol = startCol
        Loop
        
'Done!
    MsgBox "The graphs have been created successfully. The macro wil now end.", , "Success"
        
'Efficiency
    Application.ScreenUpdating = True
End Sub
Function pCTL(iCol As Integer)
Dim iteration           As Integer
Dim firstLetDouble      As Integer
Dim secondLetDouble     As Integer
iteration = Int(iCol / 26)
firstLetDouble = 64 + iteration
If iCol < 27 And iCol > 0 Then
    pCTL = Chr(iCol + 64)
End If
If iCol >= 27 Then
    secondLetDouble = iCol - (26 * iteration)
    pCTL = Chr(firstLetDouble) + Chr(secondLetDouble + 64)
End If
End Function

 

[Lou38]

That looks like crap. Sorry the formatting is bad. Just use the original code and change the below line where the red is. It will be 27. change it to 26

iAlpha = Int(iCol/27)

to

iAlpha = Int(iCol/[COLOR=#ff0000]26[/COLOR])

Dear Paul,

It worked - amazing!!! It's a task I'm going to need to a lot over the next year of this project so you've made my life an awful lot more efficient.

Thank you so much!

 

[pdevito3]

No problem. Glad I could help!

 

[Lou38]

Ah, I only saw your reply at 3:36 as hadn't scrolled to page 2 (oops!!) - that was the fix that worked for me.
It gives me a few extra graphs (which are plotting the readings at each frequency as a series I think) but I have all the individual subject graphs I need.
The last of the macro gave me a run time error (I only mention in case it's helpful for someone in future to know what worked for me - I'm very happy with my many graphs!!)

 

[JoeMo]

Indeed. The same thing happened with me. It would seem that Microsofts "ConvertToLetter" funciton has a bug! Good find, I use that a lot

Here's a simpler function that I have found dependable.

Function ColNo2ColRef(ColNo As Integer) As String
    If ColNo < 1 Or ColNo > Cells.Columns.Count Then
        ColNo2ColRef = "#VALUE!"
        Exit Function
    End If
    ColNo2ColRef = Split(Cells(1, ColNo).Address, "$")(1)
End Function

 

[pdevito3]

Thanks, Joe. I started a whole talk about it here. Had some great input.

Lou, that new code gave you an error and you're getting extra graphs?! That's not good. Can you describe it in more detail? What is it charting? It should be stopping at the determined end. If you can, feel free to post a dropbox to the data and I can try too.

Regardless, the below has a more efficient convert to letter.

Option Explicit Sub lotsOfGraphs() 'efficiency     Application.ScreenUpdating = False ' variables     Dim ct                      As ChartObject     Dim chartName               As String       ' name of chart     Dim chartNum                As Integer      ' number of chart for name     Dim trackLeft               As Double       ' tracks the placement of the left side of each graph     Dim trackTop                As Double       ' tracks the placement of the top side of each graph     Dim axisRg                  As String       ' range of data with the axis info     Dim lastCol                 As Integer      ' last column of data     Dim colHelper               As String       ' helper for do loop     Dim colCounter              As Integer      ' helper for do loop     Dim startCol                As Integer      ' tracks start col of new graph     Dim endCol                  As Integer      ' tracks end col of new graph          chartNum = 1     trackLeft = -322.5     trackTop = 166.5     axisRg = "$A$1:$A$" & Cells(Rows.Count, "A").End(xlUp).Row     lastCol = Cells(1, Columns.Count).End(xlToLeft).Column     startCol = 2      ' remove old charts     For Each ct In ActiveSheet.ChartObjects         ct.Delete     Next ct      ' add new charts     ' loop through columns         Do While endCol <= lastCol             endCol = startCol             ' loop through columns to see how many to use                 colHelper = "1"                 Do While colHelper = "1"                     If Cells(1, endCol).Value = Cells(1, endCol + 1).Value Then                         endCol = endCol + 1                     Else                         colHelper = 0                     End If                 Loop             ' add chart                 chartName = "Chart " & chartNum                 Range(axisRg & ",$" & pCTL(startCol) & "$1:$" & pCTL(endCol) & "$" & _                     Cells(Rows.Count, endCol).End(xlUp).Row).Select                 ActiveSheet.Shapes.AddChart.Select                 ActiveChart.ChartType = xlXYScatterSmoothNoMarkers                 ActiveChart.SetSourceData Source:=Range(axisRg & ",$" & pCTL(startCol) & "$1:$" & pCTL(endCol) & "$" & _                     Cells(Rows.Count, endCol).End(xlUp).Row)                 ActiveChart.Parent.Name = chartName                 ActiveSheet.Shapes(ActiveChart.Parent.Name).IncrementLeft trackLeft                 ActiveSheet.Shapes(ActiveChart.Parent.Name).IncrementTop trackTop             'setup next chart info                 chartNum = chartNum + 1                 trackLeft = trackLeft + ActiveSheet.Shapes(ActiveChart.Parent.Name).Width + 20                 startCol = endCol + 1                 endCol = startCol         Loop          'Done!     MsgBox "The graphs have been created successfully. The macro will now end.", , "Success"          'Efficiency     Application.ScreenUpdating = True End Sub 
Function pCTL(lngColNumber As Long) As String
     pCTL = Split(Cells(1, lngColNumber), "$")(1) 
End Function</pre>

 

[Lou38]

Sorry, I'm not ignoring the helpful replies, just a bit distracted looking at the graphs prior to a meeting tomorrow!

Having had a look in more detail, it plots all the data sets correctly apart from the ones which cross an letter-prefix change, so every 26 columns it goes a little bit mad and plots a summary of the previous 26 columns frequency readings.

When I get a chance will have a look at your subsequent suggestions, but the earlier macro has already got me 90% there which is great.