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
PHP Code: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
