Solved

Excel:  VBA target = Combobox.value ?

Posted on 2011-02-11
2
771 Views
Last Modified: 2012-05-11
Experts!

I have a listbox that is chnages my charts.  I would like to add a target2 to show the chart title the complete value of the selection in the listbox.

Here is the code I am adding target2

Thanks

 
Sub UpdateSummaryChartArray(ByVal lbItemCount As Integer)
Dim myRng As Variant
Dim Target As String
Dim Target2 As String  'Chart Title Name
Dim i As Integer
Dim mySeries As Series
Dim myRange As Range

   
   Target2 = ComboBox1.Value




    
    Sheets("Summary Dashboard").ChartObjects("Chart 124").Activate
    With ActiveChart
        i = .SeriesCollection.Count - 1
        For Each mySeries In .SeriesCollection
            If i > 0 Then
                mySeries.Delete
                i = i - 1
            End If
        Next mySeries
    End With
    
    For i = 0 To lbItemCount - 1 'for each item in the listbox that was selected
        Target = lbArray(i) 'keep the code as similar as possible to original combobox routine
        On Error Resume Next
        Err.Clear
        myRng = Application.WorksheetFunction.VLookup(Target, Range("Summary_Delta_Range"), Range("Summary_Delta_Range").Columns.Count, False)
        On Error GoTo 0

        
        If Err.Number = 0 And Not IsEmpty(myRng) Then
            Sheets("Summary Dashboard").ChartObjects("Chart 124").Activate
            With ActiveChart
                If i = 0 Then 'set x-axis labels only once
                    Set myRange = Range(myRng)
                    .SeriesCollection(1).XValues = "'Executive Rollup Data'!" & Range(Cells(5, myRange.Cells(1, 1).Column), Cells(5, myRange.Cells(1, myRange.Columns.Count).Column)).Address
                End If
                    
                If i > 0 Then .SeriesCollection.NewSeries ' don't create the new series till past the first one
                
                .SeriesCollection(i + 1).Values = "'Executive Rollup Data'!" & Range(myRng).Address
                .SeriesCollection(i + 1).Name = Left(Target, InStr(Target, " ") - 1) 'name = initial word before a blank space of the combobox selection
                .HasTitle = True
                .ChartTitle.Text = Target2
                .Axes(xlValue).Select
                Selection.TickLabels.NumberFormat = Range("'Executive Rollup Data'!" & myRange.Cells(1, 1).Address).NumberFormat
            End With
        Else
            'do nothing
            Sheets("Summary Dashboard").ChartObjects("Chart 124").Activate
            With ActiveChart
                .HasTitle = True
                .ChartTitle.Text = "CAN'T FIND : " & Target
            End With
        End If
    Next i
End Sub

Open in new window

0
Comment
Question by:Maliki Hassani
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
2 Comments
 
LVL 42

Accepted Solution

by:
dlmille earned 500 total points
ID: 34875688
The below code will work, if you create a named range in Executive Rollup Data called ExecutiveIDKEY

it looksup the row of the short key on the name in Executive_List

Sub UpdateSummaryChartArray(ByVal lbItemCount As Integer)
Dim myRng As Variant
Dim Target As String, Target2 As String, Target2row As Integer
Dim i As Integer
Dim mySeries As Series
Dim myRange As Range

   
    
    Sheets("Summary Dashboard").ChartObjects("Chart 124").Activate
    With ActiveChart
        i = .SeriesCollection.Count - 1
        For Each mySeries In .SeriesCollection
            If i > 0 Then
                mySeries.Delete
                i = i - 1
            End If
        Next mySeries
    End With
    
    For i = 0 To lbItemCount - 1 'for each item in the listbox that was selected
        Target = lbArray(i) 'keep the code as similar as possible to original combobox routine
        On Error Resume Next
        Err.Clear
        myRng = Application.WorksheetFunction.VLookup(Target, Range("Summary_Delta_Range"), Range("Summary_Delta_Range").Columns.Count, False)
        On Error GoTo 0
        Target2row = Application.WorksheetFunction.Match(Target, Range("ExecutiveIDKey"), False)
        Target2 = Application.WorksheetFunction.Index(Range("Executive_List"), Target2row, 1)
                
        If Err.Number = 0 And Not IsEmpty(myRng) Then
            Sheets("Summary Dashboard").ChartObjects("Chart 124").Activate
            With ActiveChart
                If i = 0 Then 'set x-axis labels only once
                    Set myRange = Range(myRng)
                    .SeriesCollection(1).XValues = "'Executive Rollup Data'!" & Range(Cells(5, myRange.Cells(1, 1).Column), Cells(5, myRange.Cells(1, myRange.Columns.Count).Column)).Address
                End If
                    
                If i > 0 Then .SeriesCollection.NewSeries ' don't create the new series till past the first one
                
                .SeriesCollection(i + 1).Values = "'Executive Rollup Data'!" & Range(myRng).Address
                .SeriesCollection(i + 1).Name = Left(Target, InStr(Target, " ")) 'name = initial word before a blank space of the combobox selection
                .HasTitle = True
                .ChartTitle.Text = Target2
                .Axes(xlValue).Select
                Selection.TickLabels.NumberFormat = Range("'Executive Rollup Data'!" & myRange.Cells(1, 1).Address).NumberFormat
            End With
        Else
            'do nothing
            Sheets("Summary Dashboard").ChartObjects("Chart 124").Activate
            With ActiveChart
                .HasTitle = True
                .ChartTitle.Text = "CAN'T FIND : " & Target
            End With
        End If
    Next i
End Sub

Open in new window

See attached.

Dave
NOC-Reports-r12.xlsm
0
 

Author Comment

by:Maliki Hassani
ID: 34875722
Great I will implement this!
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

759 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question