VBA in Excel, loop continues to run

0
votes

I have a chart in Excel that I am trying to have a loop change the color of one bar in the chart and then reference a cell for the name of the exported image file. The loop runs through multiple times and in the end i get 50 charts with the same highlighted bar with 50 different names. My end goal is to change the color for one of the 50 bars in yellow, export that chart with with a name that is located in cell D3, then change all the bars back to the same color, move on to the next bar, change it to yellow and export the chart with a name that is located in cell D4.

The 50 final chart names are located in the range of D3:D53. Below is my code. Thank you very much for your help.

Dim i As Integer, n As Integer

Dim part1 As String

For i = 1 To 50
For n = 3 To 52
part1 = Cells(n, 4)

ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Points(i).Select
With Selection.Format.Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(255, 255, 0)
    .Transparency = 0
    .Solid
End With

ActiveSheet.ChartObjects("Chart 1").Activate

ActiveChart.Export "ImageSaveLocation" & part1 & ".png"


ActiveChart.SeriesCollection(1).Select
With Selection.Format.Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(0, 112, 192)
    .Transparency = 0
    .Solid
End With

        Next n
    Next i

End Sub

2
loopsexcelreferencevba

2 Answers

1
votes

Not sure why you have nested For loop.

From what I understand, you are just changing the color of one of the series in the ActiveChart, export with names in column D, restore color, and then next series in the Chart.

Below code should work nice (assuming on act on First Chart in ActiveSheet):

Sub ChartExport()
    ' Chart Names in D3:D53
    Const lTop = 3
    Dim i As Long, lColor As Long, part1 As String

    Application.ScreenUpdating = False
    With ActiveSheet.ChartObjects(1).Chart
        For i = 1 To .SeriesCollection.Count
            part1 = ActiveSheet.Cells(lTop + i - 1).Value
            Application.StatusBar = "Exporting Chart " & part1 & " (" & i & ")..."
            ' Store Original Color, Change, Export then Restore color
            lColor = .SeriesCollection(i).Format.Fill.ForeColor.RGB
            .SeriesCollection(i).Format.Fill.ForeColor.RGB = RGB(255, 255, 0)
            .Export "ImageSaveLocation" & part1 & ".png"
            .SeriesCollection(i).Format.Fill.ForeColor.RGB = lColor
        Next
    End With
    Application.StatusBar = False
    Application.ScreenUpdating = True
End Sub
0
votes

i guess your code is not infinite looping, its just uber slow.

add some application.screenupdating=false at the begin (and =true at the end) ,

avoid to use .select/activate

dim i as long, n as long 'and not integer wich is slower ,

use set 

dim chartColl as Series 'or seriescollection ? (not sure, try)
set ChartColl= ActiveChart.SeriesCollection(1)

use with 

with ChartColl.points(i).format.fill  'untested
    .visible= msoTrue
    '...
end with

little reminder : you will create around 2500 *.png files , so your hard drive speed will be important