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

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
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

M
  • Question
Vba code to find and replace in excel closed workbooks.
Replies
1
Views
374
6StringJazzer
6StringJazzer
S
  • Question
Copy a column value when the values match to multiple sheets of the workbook
Replies
1
Views
245
sofas
S
T
  • Question
VBA Graph
Replies
1
Views
293
offthelip
O
S
  • Question
Using VBA to Flag and Calculate Overlapping Shift Times
Replies
0
Views
92
Snort
S
I
  • Question
Modify VBA script to count rows with data in multiple sheets
Replies
0
Views
131
irishjsk
I

Forum statistics

Threads
1,215,529
Messages
6,125,344
Members
449,219
Latest member
Smiqer

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