Solved

Excel: Code Modification to only proceed with Count/Average based on listbox selection

Posted on 2011-02-20
18
301 Views
Last Modified: 2012-05-11
Experts,

This one here is a little to define if you are not up to speed with my previous post.  So let me try and not butcher this up too bad.  
Issue:  In the "executive dashboard" sheet I have a listbox named #3 that display the count and average for all the ID's that are in listbox1.  I am wanting to modify the way listbox3 functions, by instead of listing ALL of the ID's and their counts and averages. I want to only show in listboxes3 the counts and averages for ONLY what ID#'s that have been selected to chart and the time frame that corresponds with that selection.  

Example:

I have selected S2 and E1 in listbox1 to chart, and I choose to see 1 month.  So this would mean that the chart is graphed with 2 ID's and listboxes3 only show the following:

ID#     Count     Averages
S2          800         200
E1          280          70


And this would be the case if I wanted to select more or less ID's.
Let me know if you have questions.. :) NOC-Reports-r24.xlsm
0
Comment
Question by:Maliki Hassani
  • 10
  • 8
18 Comments
 
LVL 41

Expert Comment

by:dlmille
ID: 34939293
Lance - are the ob buttons for timeframe working for you?

dave
0
 
LVL 41

Expert Comment

by:dlmille
ID: 34939299
never mind - just something quirky in my cobweb brain I guess...
0
 

Author Comment

by:Maliki Hassani
ID: 34939300
Yes, I have no issues...
0
 

Author Comment

by:Maliki Hassani
ID: 34939301
he he he
0
 
LVL 41

Expert Comment

by:dlmille
ID: 34939566
Lance - do you know why the selections go away on ListBox2 after plotting?
0
 

Author Comment

by:Maliki Hassani
ID: 34939594
Actually I never noticed that occurring?  Let me check..
0
 

Author Comment

by:Maliki Hassani
ID: 34939608
Yes, I see what you are talking about.  This is new..  Didn't do this before.  It probably has to do with how the mouse is rolling over.  And some where the event is turning on...  As if it is being clicked...
0
 
LVL 41

Expert Comment

by:dlmille
ID: 34939651
Check an old version and see.  I tried recreating the listbox to no avail...

Anyway, your solution to this question is here.

I created a table to the right of the average/count ranges in "Executive Rollup Data" to handle the most recent date range, and the items that were selected.  The ListBox3 is tied to this range.

The code to handle this kicks off after the chart is created.  It uses lbArray (that has the chosen elements in it) and then builds the ID's into that table on the datasheet.  The rightmost 2 columns are just lookups to the data.

Also, when the array is being built for the chart, it sets the date Range in Executive Rollup data - range "cPlotRange".  Formulas in the spreadsheet grab the right ranges for the count and average from that setting.

See the bottom of the code, below.

Sub UpdateChart_ArrayOnLBLostFocus(lBox As Variant, dataRange As String, dataSheet As String, chartSheet As String, chartID As String, obUsed As Boolean)
Dim lItem As Long
Dim lbItemCount As Integer
Dim myDateRng As Integer

    Application.EnableCancelKey = xlDisabled
    lbItemCount = 0
    If lBox.ListCount <> 0 Then 'only if something is selected, otherwise, do nothing
        For lItem = 0 To lBox.ListCount - 1 'interrogate the listbox

            If lBox.Selected(lItem) = True Then
                ReDim Preserve lbArray(lItem + 1) 'dynamically adds an item to the array
                lbArray(lbItemCount) = lBox.List(lItem) 'populates our array
                lbItemCount = lbItemCount + 1
            End If
    
        Next lItem
        Call UpdateGenericChartArray(lbItemCount, dataRange, dataSheet, chartSheet, chartID, obUsed)
        myDateRng = Sheets("Executive Rollup Data").Cells(2, Range(dataRange).Columns.Count - obMainChart).Value 'get the date range - if this will be in every summary then this could be dataSheet instead of "Executive Rollup Data"
        Range("cPlotRange").Value = myDateRng
        Call UpdateCntAvgTable(lbItemCount)
    Else
    End If
End Sub

Open in new window


Here's how it updates the table:
Sub UpdateChart_ArrayOnLBLostFocus(lBox As Variant, dataRange As String, dataSheet As String, chartSheet As String, chartID As String, obUsed As Boolean)
Dim lItem As Long
Dim lbItemCount As Integer
Dim myDateRng As Integer

    Application.EnableCancelKey = xlDisabled
    lbItemCount = 0
    If lBox.ListCount <> 0 Then 'only if something is selected, otherwise, do nothing
        For lItem = 0 To lBox.ListCount - 1 'interrogate the listbox

            If lBox.Selected(lItem) = True Then
                ReDim Preserve lbArray(lItem + 1) 'dynamically adds an item to the array
                lbArray(lbItemCount) = lBox.List(lItem) 'populates our array
                lbItemCount = lbItemCount + 1
            End If
    
        Next lItem
        Call UpdateGenericChartArray(lbItemCount, dataRange, dataSheet, chartSheet, chartID, obUsed)
        myDateRng = Sheets("Executive Rollup Data").Cells(2, Range(dataRange).Columns.Count - obMainChart).Value 'get the date range - if this will be in every summary then this could be dataSheet instead of "Executive Rollup Data"
        Range("cPlotRange").Value = myDateRng
        Call UpdateCntAvgTable(lbItemCount)
    Else
    End If
End Sub

Open in new window

note its just pulling the id's from the lbArray into the cPlotCntAvg range of the data sheet.

Also note, this is done on any generate chart - will need to discuss if you're carrying this forward to other summaries, as Executive Rollup Data sheet is hardcoded in the previous code, above - but can be changed as you develop forward.

PS - I also commented out any events associated with firing a graph with respect to ListBox3 on this Executive Summary codepage.

Cheers,

Dave
Sub UpdateCntAvgTable(lbItemCount As Integer)
Dim rPlot As Range
Dim lItem As Long

    Set rPlot = Range("cPlotCntAvg")
    rPlot.ClearContents 'clear what was last plotted
    
    For lItem = 0 To lbItemCount - 1 'then rebuild the range
        rPlot.Cells(lItem + 1, 1).Value = lbArray(lItem)
    Next lItem

End Sub

Open in new window

NOC-Reports-r25.xlsm
0
 
LVL 41

Accepted Solution

by:
dlmille earned 500 total points
ID: 34939710
Ok - I figured out why this is happening.  Because we're changing spreadsheet values during the update of ListBox2's chart - including the table, below, the listbox refills itself (even though nothing really has changed).  Not sure how to keep that from happening as I think its inherent in the control and even disabling events didn't help.

So - I added some code to reselect what got deselected...  It will maintain the selections in ListBox2 after the chart updates - but they will go away when ListBox1 is updating, as it also changes ranges on the spreadsheet when creating the ListBox3 table.

One possible fix could be to move this average/count stuff to another sheet - don't know - but that could be a chore.  Another is to not link to the datasheet the list for ListBox2 and write code to populate that list when the sheet is activated....

Take a look at the behavior and let me know how you feel about it...

Here's the code that resets the selection on ListBox2 after the fact.
Sub UpdateChart_ArrayOnLBLostFocus(lBox As Variant, dataRange As String, dataSheet As String, chartSheet As String, chartID As String, obUsed As Boolean)
Dim lItem As Long
Dim lbItemCount As Integer
Dim myDateRng As Integer

    Application.EnableCancelKey = xlDisabled
    lbItemCount = 0
    If lBox.ListCount <> 0 Then 'only if something is selected, otherwise, do nothing
        For lItem = 0 To lBox.ListCount - 1 'interrogate the listbox

            If lBox.Selected(lItem) = True Then
                ReDim Preserve lbArray(lItem + 1) 'dynamically adds an item to the array
                lbArray(lbItemCount) = lBox.List(lItem) 'populates our array
                lbItemCount = lbItemCount + 1
            End If
    
        Next lItem
        Call UpdateGenericChartArray(lbItemCount, dataRange, dataSheet, chartSheet, chartID, obUsed)
        myDateRng = Sheets("Executive Rollup Data").Cells(2, Range(dataRange).Columns.Count - obMainChart).Value 'get the date range - if this will be in every summary then this could be dataSheet instead of "Executive Rollup Data"

        Range("cPlotRange").Value = myDateRng

        Call UpdateCntAvgTable(lbItemCount)
        'now fix listbox back, just in case  <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
        For lItem = 0 To lBox.ListCount - 1
            lBox.Selected(lItem) = False
            For j = 0 To lbItemCount - 1
                If lBox.List(lItem) = lbArray(j) Then
                    lBox.Selected(lItem) = True
                End If
            Next j
        Next lItem
    Else
    End If

End Sub

Open in new window

Dave
NOC-Reports-r26.xlsm
0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 41

Expert Comment

by:dlmille
ID: 34939716
If you post a question on how to fill a Listbox activeX control that sits on a worksheet, based on data in a range (instead of directly setting that in the properties), an E-E can help us out with this one...

Dave
0
 

Author Comment

by:Maliki Hassani
ID: 34939726
Dave:  I am going to cod mine into everything you wrote.  Time to play catch up with ya..  Thanks a million!! I promise I won't bother you anymore till tomorrow...  lol  :)
0
 
LVL 41

Expert Comment

by:dlmille
ID: 34939731
Ok - gotta check on the BBQ ;)

Later,

Dave
0
 

Author Comment

by:Maliki Hassani
ID: 34939749
Wow, this is awesome stuff!!
0
 

Author Comment

by:Maliki Hassani
ID: 34940108
Food for Thought:  I don't know why my computer is considerable slowing down when I mouse over the listboxes but it is.  In the begining I wanted the scroll feature to be able to clear the selected ID's and didn't even realize that I could double click.  Anyway, I am starting to think that this mouse scroll is becoming a burden to this spreadsheet.  Thoughts?

I will see how it runs on my computer at work, but still I know that some of the managers don't have the fastes computers in the world either.  I realy hate seeing a great idea slip a way, especially the amount of time that it took to create, but we will see..

---------------------------------------------------------------
So I just touched the surface of your modifications and you really blew me away with how you even thought of doing what you did.  Now it is time for me to understand it.  I am not tracking on the new columns KG - KN.  I know the values populate when there is something charted but the formulas I can't follow. I understand the the VBA is also making it work too. Hlookup ?  I  think as I start building the other dashboards I will have a better understanding.  I like it how you provide me with steps to do so I can be independent and learn.  I think you should be a teacher... lol  Anyway, I am hitting the sack.  On top of what I have to with the spreadsheet got some reports I need to build that will set me back a day.  It's okay though, I love what I do...  One day I will be able to sit down with you and talk VBA. Till tomorrow!  Thanks Dave!
0
 
LVL 41

Expert Comment

by:dlmille
ID: 34940249
Sometimes you have to go back to go forward.  There are mouse helper controls out there, and I played with a few last night.  It runs fine on my QUAD :)

Why don't you create a public boolean variable called cDebug and set it to true somewhere.  Then in the Mouse Wheel module, check for that before it runs.  While its true, not to run.  That way you can focus on function and then come back to this by just turning cDebug to False.

Follow me?

 
Const cDebug As Boolean = True

Sub HookListBox(ListBox As MSForms.ListBox)
    If cDebug Then Exit Sub '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    Dim tPt As POINTAPI
    
    Set oListBox = ListBox
    GetCursorPos tPt
    lListBoxhwnd = (WindowFromPoint(tPt.x, tPt.y))
    PostMessage lListBoxhwnd, WM_LBUTTONDOWN, 0, 0
    If Not bHookSet Then
        lMouseHook = SetWindowsHookEx _
        (WH_MOUSE_LL, _
        AddressOf LowLevelMouseProc, GetAppInstance, 0)
        If lMouseHook <> 0 Then
            bHookSet = True
        End If
    End If
 
End Sub

Open in new window

that keeps the Windows Hook from running...

A good thing to have if you have a "boss attack" :)  You could even store it in a cell and reference that on Sheet Activate (make cDebug a regular Public Variable, instead of hardcoded Const).

Nite,

Dave
0
 
LVL 41

Expert Comment

by:dlmille
ID: 34940263
Oh - the VBA posts the obMainChart value in the Executive Rollup Data sheet - KG9.  The hlookup is finding THAT value in the Average and Count tables we created earlier, as the COLUMN where to look for the right date range, and the current row, the row - as its finding it for ALL id's.  

THEN, based on what posts in the column KK (comes from VB - the list of selected id's), the columns KL - KN do the Vlookups against the table in the first step...

:)

Cheers,

dave
0
 
LVL 41

Expert Comment

by:dlmille
ID: 34940267
Finally, column KL determines if its the LONG ID# with description or SHORT one, and parses out the first "word" from the ID based on that.

Dave
0
 

Author Comment

by:Maliki Hassani
ID: 34945376
Okay, I understand now.  Working on some charts to graph then back to play. Closing this question out now. Thanks
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
PaperPort has a feature called the "Send To Bar". It provides a convenient, drag-and-drop interface for using other installed software, such as Microsoft Office. However, this article shows that the latest Office 2016 apps (installed with an Office …
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

762 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

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now