Graphing with Dynamic Ranges VBA

S

sportsfan5500

New Member
Joined
Dec 5, 2011
Messages
4
Hi guys, so I have a userform where a person selects their choices, and based on these choices it will create a graph. All of the dynamic ranges have been constructed correctly as I have checked them several times. Everything seems to work, until I try and add series. On the "GraphARR(icolumn)" I get an error saying that "application defined or object defined error". Please help, I will greatly appreciate it! The code is long, but repetitive (I don't think I coded it the most efficient way possible). The error is in the by the end.

Code: 
Public Sub cmdgraph_Click()

Dim ada, adb, adc, ad, ade, adf, adg, adh, adi, adj, adepa, adepb, adepc, adepd, adepe, adepf, adepg, adeph, adepi, adepj, _
ocha, ochb, ochc, ochd, oche, ochf, ochg, ochh, ochi, ochj, ochepa, ochepb, ochepc, ochepd, ochepe, ochepf, ochepg, ocheph, ochepi, ochepj, _
pa, pb, pc, pd, pe, pf, pg, ph, pi, pj, popa, popb, popc, popd, pope, popf, popg, poph, popi, popj As String
Dim i As Integer
Dim x As Integer
Dim last_row As Integer
Dim cround As Integer
Dim eround As Integer
Dim y As Integer
Dim b As Integer
Dim d As Integer
Dim g As Integer
Dim rngchtxval As Range
Dim mychtobj As ChartObject
Dim icolumn As Long
Dim chartrng As Range
Dim yname As String
Dim xname As String
Dim o As Integer
Dim n As Integer
Dim p As Integer
Dim x2 As Integer
Dim q As Integer
Dim graphARR(1 To 10) As String
Dim c As Integer
Dim num_ser As Integer

Dim j As Integer


xname = "Round"
cround = fromspinbutton.Value + 1
eround = tospinbutton.Value + 1

Worksheets("Graph Range").Range("P2").Value = cround - 1
Worksheets("Graph Range").Range("q2").Value = eround - 1

 ada = "=='Workbook1.xlsm'!AD_A"
 adb = "=='Workbook1.xlsm'!AD_B"
 adc = "=='Workbook1.xlsm'!AD_C"
 ad = "=='Workbook1.xlsm'!AD_D"
 ade = "=='Workbook1.xlsm'!AD_E"
 adf = "=='Workbook1.xlsm'!AD_F"
 adg = "=='Workbook1.xlsm'!AD_G"
 adh = "=='Workbook1.xlsm'!AD_H"
 adi = "=='Workbook1.xlsm'!AD_I"
 adj = "=='Workbook1.xlsm'!AD_J"

 adepa = "=='Workbook1.xlsm'!ADEP_A"
 adepb = "=='Workbook1.xlsm'!ADEP_B"
 adepc = "=='Workbook1.xlsm'!ADEP_C"
 adepd = "=='Workbook1.xlsm'!ADEP_D"
 adepe = "=='Workbook1.xlsm'!ADEP_E"
 adepf = "=='Workbook1.xlsm'!ADEP_F"
 adepg = "=='Workbook1.xlsm'!ADEP_G"
 adeph = "=='Workbook1.xlsm'!ADEP_H"
 adepi = "=='Workbook1.xlsm'!ADEP_I"
 adepj = "=='Workbook1.xlsm'!ADEP_J"


 pa = "=='Workbook1.xlsm'!P_A"
 pb = "=='Workbook1.xlsm'!P_B"
 pc = "=='Workbook1.xlsm'!P_C"
 pd = "=='Workbook1.xlsm'!P_D"
 pe = "=='Workbook1.xlsm'!P_E"
 pf = "=='Workbook1.xlsm'!P_F"
 pg = "=='Workbook1.xlsm'!P_G"
 ph = "=='Workbook1.xlsm'!P_H"
 pi = "=='Workbook1.xlsm'!P_I"
 pj = "=='Workbook1.xlsm'!P_J"

 popa = "=='Workbook1.xlsm'!Pop_A"
 popb = "=='Workbook1.xlsm'!Pop_B"
 popc = "=='Workbook1.xlsm'!Pop_C"
 popd = "=='Workbook1.xlsm'!Pop_D"
 pope = "=='Workbook1.xlsm'!Pop_E"
 popf = "=='Workbook1.xlsm'!Pop_F"
 popg = "=='Workbook1.xlsm'!Pop_G"
 poph = "=='Workbook1.xlsm'!Pop_H"
 popi = "=='Workbook1.xlsm'!Pop_I"
 popj = "=='Workbook1.xlsm'!Pop_J"



If eround = 1 Then
    MsgBox ("You have chosen to only graph 1 round of data." & Chr(13) & "Please increase your range to at least 2 rounds.")
    Call UserForm_Initialize
    Exit Sub
End If



With Worksheets("Graphs")


If optdata1 = True Then
    .Range("u1").Value = 1
End If
    

If optdata2 = True Then
    .Range("u1").Value = 2
End If


If optdata3 = True Then
    .Range("u1").Value = 3
End If


If optdata4 = True Then
    .Range("u1").Value = 4
End If
    
End With


i = Worksheets("Graphs").Range("u1").Value

'Bids
If optb = True Then
    Worksheets("Graphs").Range("w1").Value = 1
    yname = "(Bids)"
End If
    
'Eligibility Points
If optep = True Then
    If Worksheets("Graphs").Range("u1").Value = 2 Or Worksheets("Graphs").Range("u1").Value = 3 Then
    MsgBox ("Error: Eligibility Points cannot be used with Price graphs.  Please change your selection")
    Exit Sub
    Else
    Worksheets("Graphs").Range("w1").Value = 2
    yname = "(Eligibility Points)"
    End If
End If





'this is the position in graphARR
c = 1

If Sheets("Graphs").Range("V1") = True Then
    For n = 2 To 11
    Sheets("Graphs").Cells(n, 22) = True
    Next
End If


With Sheets("Graphs")

Select Case i

    Case Is = 1
        If .Range("w1") = 2 Then
            'they want points
            
            Worksheets("graph range").Activate
            
            If .Cells(2, 22) = True Then
            graphARR(c) = adepa
            c = c + 1
            End If
            
            
            If .Cells(3, 22) = True Then
            graphARR(c) = adepb
            c = c + 1
            End If
            
            If .Cells(4, 22) = True Then
            graphARR(c) = adepc
            c = c + 1
            End If
            
            If .Cells(5, 22) = True Then
            graphARR(c) = adepd
            c = c + 1
            End If
            
            If .Cells(6, 22) = True Then
            graphARR(c) = adepe
            c = c + 1
            End If
            
            If .Cells(7, 22) = True Then
            graphARR(c) = adepf
            c = c + 1
            End If
            
            If .Cells(8, 22) = True Then
            graphARR(c) = adepg
            c = c + 1
            End If
            
            If .Cells(9, 22) = True Then
            graphARR(c) = adeph
            c = c + 1
            End If
            
            If .Cells(10, 22) = True Then
            graphARR(c) = adepi
            c = c + 1
            End If
            
            If .Cells(11, 22) = True Then
            graphARR(c) = adepj
            c = c + 1
            End If

        Else:
            Worksheets("graph range").Activate
            If .Cells(2, 22) = True Then
            graphARR(c) = ada
            c = c + 1
            End If
            
            If .Cells(3, 22) = True Then
            graphARR(c) = adb
            c = c + 1
            End If
            
            If .Cells(4, 22) = True Then
            graphARR(c) = adc
            c = c + 1
            End If
            
            If .Cells(5, 22) = True Then
            graphARR(c) = ad
            c = c + 1
            End If
            
            If .Cells(6, 22) = True Then
            graphARR(c) = ade
            c = c + 1
            End If
            
            If .Cells(7, 22) = True Then
            graphARR(c) = adf
            c = c + 1
            End If
            
            If .Cells(8, 22) = True Then
            graphARR(c) = adg
            c = c + 1
            End If
            
            If .Cells(9, 22) = True Then
            graphARR(c) = adh
            c = c + 1
            End If
            
            If .Cells(10, 22) = True Then
            graphARR(c) = adi
            c = c + 1
            End If
            
            If .Cells(11, 22) = True Then
            graphARR(c) = adj
            c = c + 1
            End If
            
        End If
    yname = "Demand" & " " & yname

    Case Is = 2
            Worksheets("graph range").Activate
            If .Cells(2, 22) = True Then
            graphARR(c) = pa
            c = c + 1
            End If
            
            If .Cells(3, 22) = True Then
            graphARR(c) = pb
            c = c + 1
            End If
            
            If .Cells(4, 22) = True Then
            graphARR(c) = pc
            c = c + 1
            End If
            
            If .Cells(5, 22) = True Then
            graphARR(c) = pd
            c = c + 1
            End If
            
            If .Cells(6, 22) = True Then
            graphARR(c) = pe
            c = c + 1
            End If
            
            If .Cells(7, 22) = True Then
            graphARR(c) = pf
            c = c + 1
            End If
            
            If .Cells(8, 22) = True Then
            graphARR(c) = pg
            c = c + 1
            End If
            
            If .Cells(9, 22) = True Then
            graphARR(c) = ph
            c = c + 1
            End If
            
            If .Cells(10, 22) = True Then
            graphARR(c) = pi
            c = c + 1
            End If
            
            If .Cells(11, 22) = True Then
            graphARR(c) = pj
            c = c + 1
            End If
            
    yname = "Price"

    Case Is = 3
    Worksheets("graph range").Activate
            If .Cells(2, 22) = True Then
            graphARR(c) = popa
            c = c + 1
            End If
            
            If .Cells(3, 22) = True Then
            graphARR(c) = popb
            c = c + 1
            End If
            
            If .Cells(4, 22) = True Then
            graphARR(c) = popc
            c = c + 1
            End If
            
            If .Cells(5, 22) = True Then
            graphARR(c) = popd
            c = c + 1
            End If
            
            If .Cells(6, 22) = True Then
            graphARR(c) = pope
            c = c + 1
            End If
            
            If .Cells(7, 22) = True Then
            graphARR(c) = popf
            c = c + 1
            End If
            
            If .Cells(8, 22) = True Then
            graphARR(c) = popg
            c = c + 1
            End If
            
            If .Cells(9, 22) = True Then
            graphARR(c) = poph
            c = c + 1
            End If
            
            If .Cells(10, 22) = True Then
            graphARR(c) = popi
            c = c + 1
            End If
            
            If .Cells(11, 22) = True Then
            graphARR(c) = popj
            c = c + 1
            End If
            
    yname = "Price per Pop"



        
    End Select

    End With




'The Number of Series that needs to be added
num_ser = c - 1

Worksheets("graph range").Activate
Set rngchtxval = Worksheets("Graph Range").Range("s" & cround - 1, "s" & eround - 1)


    Set mychtobj = Worksheets("Graphs").ChartObjects.Add(Left:=250, Width:=375, Top:=75, Height:=225)

    mychtobj.Activate

    With ActiveChart

    Do Until .SeriesCollection.Count = 0
    ActiveChart.SeriesCollection(1).Delete
    Loop



    For icolumn = 1 To num_ser
        With ActiveChart.SeriesCollection.NewSeries
           .Values = graphARR(icolumn)
            .XValues = rngchtxval
        End With
    Next
  End With

With ActiveChart.Parent
    Set chartrng = Range("B4:W30")
  .Left = chartrng.Left
  .Width = chartrng.Width
  .Top = chartrng.Top
  .Height = chartrng.Height

  End With



Sheets("price").Visible = False
End Sub
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Sort by date Sort by votes
Why have you got doubled equals in your definitions:
Code: 
popa = "=='Workbook1.xlsm'!Pop_A"

?

Shouldn't that be:
Code: 
popa = "='Workbook1.xlsm'!Pop_A"
 
Upvote 0
Also, the named ranges, for example AD_A represent a forumla like

=OFFSET(AggregateDemand!$A$1,'Graph Range'!$P$2,1,'Graph Range'!$Q$2-'Graph Range'!$P$2+1,1)

When I go into the name manager and click this range, it produces the correct range.
 
Upvote 0
Did you go into Debug mode, and look at the value of graphARR(icolumn)?

And what is displayed in the immediate window when you type
? ActiveWorkbook.Name
there?
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
VBA to declare column headers and use in further code
Replies
6
Views
413
AggieJess27
A
J
  • Question Question
Automatically move cells from one sheet to another based on criteria using VBA
Replies
5
Views
707
DanteAmor
DanteAmor
M
  • Question Question
VBA move to different worksheet depending on the cell value
Replies
3
Views
264
jolivanes
jolivanes
P
  • Solved
Export Worksheets into a Single PDF using Criteria on each Worksheet
Replies
7
Views
542
jolivanes
jolivanes
N
  • Question Question
VBA - Intersect code being re-initiated
Replies
1
Views
182
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,223,243
Messages
6,170,964
Members
452,371
Latest member
Frana

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top