Loop problem

[Skibum346]

Guys and Galls or if you prefer... Gals & Guys!

I have created a workbook in excel to compile resultsfrom a questionnaire (cuz my databasing skills in Access aint up to it!).

I have built code that removes redundant rows on two sheets, then builds charts from the remaining data.

I have a problem when I run it, it seems to lock into a loop which I can't see.

This is particularly confusing to a newbie as I copied the code from another project that works fine.

Can anyone spot the problem?

Thanks in advance

Frank

Sub QuestionsChart()

'Builds Chart for Questions

Dim DATA
Dim CURRENT_ROW


DATA = Sheets("Questions Chart Ranges").Range("a1:b50")
CURRENT_ROW = 1

For Each DATALINE In DATA

Do
    If IsError(Sheets("Questions Chart Ranges").Range("b" & CURRENT_ROW)) Then
    Rows(CURRENT_ROW & ":" & CURRENT_ROW).Select
    Selection.Delete Shift:=xlUp
    End If
Loop Until IsError(Sheets("Questions Chart Ranges").Range("b" & CURRENT_ROW)) = False  'Ends delete redundant rows.

CURRENT_ROW = CURRENT_ROW + 1

Next DATALINE

    ActiveSheet.Protect (********)

    Application.Goto Reference:="QuestionChartRange"                                   'Selects Chart Range
    Charts.Add                                                                         'Adds new chart
    ActiveChart.ChartType = xlColumnClustered                                          'Specifies chart type
    ActiveChart.SetSourceData Source:=Sheets("Questions Chart Ranges").Range( _
        "A1:B5"), PlotBy:=xlColumns                                                    'Builds chart
    ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Questions Chart"          'Creates as new worksheet
    With ActiveChart                                                                   'Sets chart title details
        .HasTitle = False
        .Axes(xlCategory, xlPrimary).HasTitle = False
        .Axes(xlValue, xlPrimary).HasTitle = False
    End With
    ActiveChart.HasLegend = False                                                      'Sets chart legend details
    ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False
    ActiveWindow.Zoom = 85                                                              'Zooms chart size
    ActiveChart.SeriesCollection(1).DataLabels.Select                                   'Sets data labels format and position
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Position = xlLabelPositionInsideEnd
        .Orientation = xlHorizontal
    End With
    ActiveChart.Deselect
    Sheets("Questions Chart").Select
    Sheets("Questions Chart").Move After:=Sheets(5)
    Call ButtonForGraph

End Sub 

[Shaggy Hiker]

Much of this appears spreadsheet specific, but one question for you:

If you break in the loop, where do you break at.

Can you step through the code (F8 in VB, but I don't know what in Excel/VBA)? If you can, and the infinite loop is the loop in your code, then you will probably find that the loop control statement is not doing quite what you expect it to.

[IROY55]

1. Try using VBCODE tags instead of PHP.
2. See changes to your code.

For Each DATALINE In Data
    Do
        If IsError(Sheets("Questions Chart Ranges").Range("b" & CURRENT_ROW)) Then
            Rows(CURRENT_ROW & ":" & CURRENT_ROW).Select
            Selection.Delete Shift:=xlUp
            'you may now decide if you want to get out of the loop
            Exit Do
        End If
    Loop Until IsError(Sheets("Questions Chart Ranges").Range("b" & CURRENT_ROW)) = False  'Ends delete redundant rows.
    CURRENT_ROW = CURRENT_ROW + 1
Next DATALINE

[andreys]

IROY55 is right, you have to leave loop or increase CURRENT_ROW value in 1:

Do
    If IsError(Sheets("Questions Chart Ranges").Range("b" & CURRENT_ROW)) Then
    Rows(CURRENT_ROW & ":" & CURRENT_ROW).Select
    Selection.Delete Shift:=xlUp
    End If
    'increase CURRENT_ROW value 
    CURRENT_ROW=CURRENT_ROW+1
Loop Until IsError(Sheets("Questions Chart Ranges").Range("b" & CURRENT_ROW)) = False