CODEWITHSUNDEEP
excelvbaloopsexcel-charts
Elis
Elis

Reputation: 41

Removing 'chartobjects' from 'chartobjects' object while looping

My VBA code loops through a sequence of ranges, and checks that only one chart is inside of each range, deleting any extra charts. I'd like to remove any charts I've already dealt with from the chartobjects collection I'm looping through, how do I remove a chartobject from a chartobjects?

Here's my current code.

Dim ChartsNotChecked As ChartObjects
Dim ChartsChecked As ChartObjects

Dim i As Long
Dim j As Long

Dim ChartBox As Range
Dim Char As ChartObject
Dim FirstChart As ChartObject
Dim OneFound As Boolean

Set ChartsNotChecked = ActiveSheet.ChartObjects
For j = 10 To 100 Step 10
    Set ChartBox = Range(Cells(1, j - 9), Cells(10, j))
    
    OneFound = False
    
    For Each Char In ChartsNotChecked
        
        If Not Intersect(Char.TopLeftCell, ChartBox) Is Nothing Then 'check if chart intersects current chartbox
            
            If Not OneFound Then 'catches first intersecting chart automatically
            
                Set FirstChart = Char
                OneFound = True
            
            Else
                If Not FirstChart Is Nothing Then Char.Delete 'deletes any other charts
            
            End If
        End If
        
    Next Char

'format FirstChart    
'remove FirstChart from ChartsNotChecked
'add FirstChart to ChartsChecked

Next j

Upvotes: 0

Views: 57

Answers (1)

Tim Williams
Tim Williams

Reputation: 166146

EDITED - first put all charts into a collection, so you can remove them as you go.

Sub GG()
    
    Dim allCharts As New Collection
    Dim ChartsChecked As New Collection
    Dim i As Long, j As Long
    Dim ChartBox As Range
    Dim Char As ChartObject
    Dim OneFound As Boolean, ws As Worksheet
    
    Set ws = ActiveSheet
    
    'make a collection of all chartobjects
    For Each Char In ws.ChartObjects
        allCharts.Add Char
    Next Char
    
    For j = 10 To 100 Step 10
        Set ChartBox = ws.Range(ws.Cells(1, j - 9), ws.Cells(10, j))
        OneFound = False
        For i = allCharts.Count To 1 Step -1 'work backwards
            Set Char = allCharts(i)
            If Not Intersect(Char.TopLeftCell, ChartBox) Is Nothing Then 'check if chart intersects current chartbox
                If Not OneFound Then 'catches first intersecting chart
                    OneFound = True
                Else
                    Char.Delete 'deletes any other charts
                End If
                allCharts.Remove i 'remove from collection: was kept or deleted
            End If
        Next i
    Next j
End Sub

Upvotes: 1

Related Questions