Create a graph of a column with gaps between data

I'm trying to create graphs of every column of data in a worksheet. As of right now it works as long as there are no gaps in the column of data, but I need it to be robust enough that it works if there are gaps in the data. The data is entered in batches with different columns having different lengths due to different measurement requirements. Each of the rows will also have an identifier in the first column indicating what batch of data that row comes from (see attached file). Since the identifier column will be the same length as the longest data column, I compare the last row of that to the bottom row of any given data column to make sure all the data is getting graphed. However right now the it gets stuck in the loop if there's a gap in the data.

Sub GraphAllColumns()
    Dim col As Range 'The cell at the top of the data column
    Dim bottomRow As Range
    Dim bottomData As Range

    Set col = ActiveSheet.Range("B7")
    Set bottomRow = Range("A7").End(xlDown)

    col.Select

    If Not IsEmpty(Selection) Then 'If the worksheet is empty, nothing happens
        Do
            Set bottomData = Selection.End(xlDown)
            If bottomRow.Row <= bottomData.Row Then
                'Iterate through every column, select all the data in that column
                'then call the create graph subroutine
                Call CreateGraph
                ActiveCell.Offset(0, 1).Select
            Else
                If IsEmpty(Selection.End(xlDown)) Then
                    Call CreateGraph
                    ActiveCell.Offset(0, 1).Select
                Else
                    Range(Selection, Selection.End(xlDown)).Select
                End If
            End If
        Loop Until IsEmpty(Selection)
    End If    
End Sub

Here's the CreateGraph subroutine as well. I'm happy the way that it works. I know it isn't the best way, but this is my first time using VBA.

Sub CreateGraph()
    Dim startCell As Range      'Starting cell (important for column selection)
    Dim graphRange As Range

    Set startCell = Selection
    Set graphRange = Range(startCell, startCell.End(xlDown))  'Selects all data in column

    'Create chart, define chart type and source data
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlLine
    ActiveChart.SetSourceData Source:=graphRange

    'Change chart location so that all charts on a sheet are stacked in top left corner
    With ActiveChart.Parent
        .Top = Range("A1")
        .Left = Range("A1")
    End With

    'Change chart title and other attributes
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Text = startCell.Offset(-2, 0).Value
    
    End With
End Sub

Picture of data gap

from Recent Questions - Stack Overflow https://ift.tt/3HR5OG5
https://ift.tt/eA8V8J