Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 380
  • Last Modified:

Taking Dynamic Table Selection to the next level.

This is a great little macro by Dlmiele (Dave).  

There are several things that need to be done to it to take it to the next level;

1.) Events On needs to be an  automatic function that doesn't require resetting.
2.) A category for the data needs to be added (Industry) by Question.  However, there need not be an industry tab (for selection) but only a macro that when initiated, only allows for the sorts to run against that designated industry (the exact spelling in the column (e.g. retail, banking, telcom, etc.). It could be placed in B1 if you want to set it up as another Category instead of hiding it.  Also, the macro should have the ability to recognize the word "ALL" meaning, put all questions, regardless of Industry Designation, into the other sort routines for analysis.
3.) A macro needs to be in place to "summarize" which means that all Questions that have answers are displayed.  By pushing "Clear Current" the model resets itself to leaving the answers in the DB while resetting the sort.

Those changes take this model to the next level.

Thank you,

Bright01

 Dynamic-Table-Lookup-scaled-v4.xlsm
0
Bright01
Asked:
Bright01
  • 11
  • 9
  • 6
1 Solution
 
Arno KosterCommented:
1]
place this code in the ThisWorksheet section in the VBA editor
Private Sub Workbook_Open()
    EventsOn
End Sub

Open in new window

0
 
Arno KosterCommented:
2]

Update the loadMyListObjectUnique macro in the DataValidationAndUniqueHandling section
(added one line just above the last "else" statement)

Sub loadMyListObjectUnique(listObject As OLEObject, Optional Sorted As Variant = False, Optional mLink As Variant = False)
Dim listObjectRangeTest As Range, listObjectRange As Range, listObjectLinkExists As Boolean, sBuildListObjectName As String
Dim uniqueListObjectList As Dictionary 'could be number or text
Dim myArray As Variant
Dim checkObjectRows As Long 'need to understand whether the list is > 0, testing comboBox or listBox attributes, depending on which is used

    'listObject is the list object (e.g., ComboBox or ListBox) Active-X control for this operation.  mLink is an optional parameter which instructs the app to sustain linkage with the
    'listfill range, even though the end result will be a list object with set values.  The way this app sustains linkage is to create a defined
    'name range built around the name of the list object and containing its initialized list fill range.
    
    'some preliminary setup.  Assuming there's a requirement to maintain the link between the data and the list object, build the range name
    'based on the list object name.  Then test to see whether there's already a range that has been assigned to this list object, setting the flag
    'listObjectLinkExists.
    
    sBuildListObjectName = "_" & listObject.Name & "_Range"
    On Error Resume Next
    Set listObjectRangeTest = Range(sBuildListObjectName)
    If Err.Number <> 0 Then
        listObjectLinkExists = False
    Else
        listObjectLinkExists = True
    End If
    Err.Clear
    On Error GoTo 0
    
    If Not mLink Then 'maintaining linkage is not desired, so delete references from defined names, if any, and clear the listObjectLinkExists flag
        On Error Resume Next 'just in case the name never existed
        Application.Names(sBuildListObjectName).Delete
        On Error GoTo 0
        listObjectLinkExists = False
    End If
        
    'Start the process by getting the list fill range from the list object.  If it exists, then use that range.  If it does NOT exist, test
    'to see whether there was a linkage created via the defined name created for the list object.  If THAT linkage exists, then fill the listbox
    'as it was originally set up.  If it does NOT exist, then fall through and warn the user that a fill range must be set up to initialize the
    'list object.
    
    Set listObjectRange = obtainListObjectListRange(listObject)
    
    On Error Resume Next
    checkObjectRows = listObject.Object.ListRows 'if a comboBox
    If Err.Number <> 0 Then
        checkObjectRows = listObject.Index 'if a listBox
    End If
    On Error GoTo 0
    'if the list object has no set list fill range to work with, there is no linkage, and the list object actually has data, then the list object has been initialized with values that are unique already, there's nothing to do
    If listObjectRange Is Nothing And Not mLink And checkObjectRows > 0 Then Exit Sub 'nothing to do
    
    If Not listObjectRange Is Nothing Or listObjectLinkExists Then 'either the list fill range of the list object is set, or a prior link exists
        
        'save the range for refresh linkage
        
        If listObjectLinkExists And listObjectRange Is Nothing Then 'there is no list fill range, but the link does exist, so proceed by setting the list object up as it was originally
            listObject.ListFillRange = "'" & listObjectRangeTest.Parent.Name & "'!" & listObjectRangeTest.Address
        ElseIf mLink Then 'if link is to be maintained, then save the range tied to the list object reference in the defined names area
            Application.Names.Add Name:="'" & ActiveSheet.Name & "'!" & sBuildListObjectName, RefersTo:="=" & listObject.ListFillRange, Visible:=True 'hide the range name
        End If
        
        'regardless of the cases above, we now have a list range from which to work - either from the fill range, or a prior link
        'first, create a unique list of elements from the list object "contents", re: its list fill range, in the getListObjectUnique function
        
        Set uniqueListObjectList = getListObjectUnique(listObject) ' ok - got the unique list in the dictionary
        
        'now clear the list object and load it with unique values
        
        listObject.ListFillRange = "" 'clear the list object
        
        'iterate through the dictionary uniqueListObjectList Keys to get at the elements stored there (re: the unique set of elements in the original
        'list fill range
        If Not Sorted Then 'load the list object
            For i = 0 To uniqueListObjectList.Count - 1
                listObject.AddItem uniqueListObjectList.Keys(i)
            Next i
        Else 'sort first
            myArray = uniqueListObjectList.Keys
            Call QSort(myArray, LBound(myArray), UBound(myArray))
            For i = 0 To uniqueListObjectList.Count - 1 'now load the list object with sorted array
                listObject.Object.AddItem myArray(i)
            Next i
        End If
        
        '-- add addition value
        If listObject.LinkedCell = "$B$3" Then listObject.Object.AddItem "Industry"
        
    Else
        MsgBox "Please Go to the list object: " & listObject.Name & " and set the Property called ""ListFillRange"" then run this macro"
    End If
    
End Sub

Open in new window

0
 
Arno KosterCommented:
it seems that i misunderstood your expectations for question 2, please dot not use the code fragment yet...
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
Arno KosterCommented:
3] summarize :

copy paste a button (this would become 'CommandButton4')
edit properties to change the caption to "Summarize"
use this macro code in the Sheet2 VBA section


Private Sub CommandButton4_Click()
'-- all Questions that have answers are displayed
Dim pos As Double

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    For pos = 2 To UsedRange.Rows.Count
        If Range("D" & pos) = "" Then
            Exit For
        ElseIf Range("E" & pos) = "" Then
            Range("D" & pos + 1 & ":E" & UsedRange.Rows.Count).Cut Destination:=Range("D" & pos & ":E" & UsedRange.Rows.Count - 1)
            pos = pos - 1
        End If
    Next pos

    Application.EnableEvents = True
    Application.ScreenUpdating = True
    

End Sub

Open in new window

0
 
Arno KosterCommented:
3] clear current :

choose
Private Sub CommandButton2_Click()
Dim LastRowD As Long

    Application.EnableEvents = False
    TempComboActive = False
    Range("B8").Select
    Range("B1:B4").ClearContents
    '-- instead of clearing all questions and answers, keep answered questions visible
    '    LastRowD = Range("D" & Rows.Count).End(xlUp).Row + 1
    '    Range("D2:E" & LastRowD).ClearContents
    CommandButton4_Click
    
    TempComboActive = True
    Application.EnableEvents = True
    
End Sub

Open in new window

 when you want to perform the summarize process while clearing up.

otherwise, use :
Private Sub CommandButton2_Click()
Dim LastRowD As Long

    Application.EnableEvents = False
    TempComboActive = False
    Range("B8").Select
    Range("B1:B4").ClearContents
    '--  keep current questions
    '    LastRowD = Range("D" & Rows.Count).End(xlUp).Row + 1
    '    Range("D2:E" & LastRowD).ClearContents
    
    TempComboActive = True
    Application.EnableEvents = True
    
End Sub

Open in new window


this way only the B1 ~ B4 cells will be cleared
0
 
Arno KosterCommented:
for the answer to question 2, it might be best if you contact dave !
I think that he has a more clear understanding of your expectations than I have...
0
 
dlmilleCommented:
>>1.) Events On needs to be an  automatic function that doesn't require resetting.

I removed EventsOn macro.  I trigger Application.EnableEvents = True on tab changes and already Events On/Off are triggered by button pushes, per standard.


>>2.) A category for the data needs to be added (Industry) by Question.  However, there need not be an industry tab (for selection) but only a macro that when initiated, only allows for the sorts to run against that designated industry (the exact spelling in the column (e.g. retail, banking, telcom, etc.). It could be placed in B1 if you want to set it up as another Category instead of hiding it.  Also, the macro should have the ability to recognize the word "ALL" meaning, put all questions, regardless of Industry Designation, into the other sort routines for analysis.

I added an Industry filter list and populated it with dummy data to test.  You'll need to populate this with what you want.  I'm a bit confused by what you want to do with it.  

>>3.) A macro needs to be in place to "summarize" which means that all Questions that have answers are displayed.  By pushing "Clear Current" the model resets itself to leaving the answers in the DB while resetting the sort.

the SummarizeButton calles the current FilterRequest() routine with an additional optional parameter:  FilterRequest(dropDownOnly As Boolean, Optional keyOn As Variant, Optional summaryOnly As Variant = False)

I created a DataValidation_Range defined name to clear the entries.  Also, I added the variable extraCol = 1 on Summarize to inform the FilterRequest() to work with Question & Answer, rather than just Question on the data retrieve.


I have to run to a meeting so can get back to this in a few hours.  I've not completed testing but seems to work in the 5 min's or so of testing.  Will test further, when I return and then hoping to get more input on the Industry column.

I added a few more named ranges I'll mention in my conclusion.  Here's my current status...

See attached file.

Enjoy!

Dave
Dynamic-Table-Lookup-scaled-v5b.xlsm
0
 
dlmilleCommented:
Ok - Range Names Created thus far:

DataValidation_Range - the yellow cells
AnswerListTop - The header of the answers in the Question Database (L1)
QuickAnswerTop - The header of the answers in the Results Area (E1)
QuestionListTop - The header of the questions in the Question Database (K1)
Criteria - Sets criteria for advanced filtering (AAB1:AAH2)
QuestionSet - the Question Database header (F1:L1)

And then again the dynamic ranges:

Structured_List:
=Questions!$AAL$2:INDEX(Questions!$AAL:$AAL,MATCH(REPT("Z",20),Questions!$AAL:$AAL))

Industry_List:
=Questions!$AAM$2:INDEX(Questions!$AAM:$AAM,MATCH(REPT("Z",20),Questions!$AAM:$AAM))

Type_List:
=Questions!$AAN$2:INDEX(Questions!$AAN:$AAN,MATCH(REPT("Z",20),Questions!$AAN:$AAN))

LOB_List:
=Questions!$AAO$2:INDEX(Questions!$AAO:$AAO,MATCH(REPT("Z",20),Questions!$AAO:$AAO))

Scenario_List:
=Questions!$AAP$2:INDEX(Questions!$AAP:$AAP,MATCH(REPT("Z",20),Questions!$AAP:$AAP))


I've done a bit more testing and the new Industry column and everything else requested appears to be working correctly now.  Please download THIS version.

Please also elaborate on the functionality of the Industry Column and this macro/sort capability you're looking for.  Remember to also populate that column with your own data, as I just did a copy/paste from another column to test functionality.

See attached -

Dave
Dynamic-Table-Lookup-scaled-v5c.xlsm
0
 
Bright01Author Commented:
Dave,

Greetings!  Travel week from hell....stuck twice in Phoenix for two nights (coming and going) and not into the hotel until after mid-night.   So sorry for not getting back with you sooner.  I tested the spreadsheet, and it looks very good; one minor bug so far;

If you select Summarize after clearing, you get all the questions.  You should only get those questions that you have answered.  The idea here is that you make a selection, Answer several of the questions, then clear it; and again sort down another set of questions.  The answers remain (until you clear all).  At any point in time, you should be able to Summarize and it lists only those Q and As that you have actually assigned As to.

B.


0
 
dlmilleCommented:
Ahhh - I get it.  Will revert shortly - have to haul kids around for awhile.

Dave
0
 
dlmilleCommented:
Ok - I created a new named range, called "CriteriaAnswer" so when you hit Summarize, I put <> in the criteria for the Answer criteria.  That way, only questions with answers are pulled.

See attached,

Enjoy!

Dave
Dynamic-Table-Lookup-scaled-v6.xlsm
0
 
dlmilleCommented:
Let's go with this one - needed to clear the last retrieval before next query...

Dave
Dynamic-Table-Lookup-scaled-v6b.xlsm
0
 
dlmilleCommented:
Bright01 - I did a bit more error checking and noticed if you put an answer in where there was no question, nothing was saved, but that pesky answer just sat there.

In this version, I popup an alert that you can't put an answer there, and erase the answer, afterward.

E.g., try to put an answer where there is no question, lower down, to see what I mean.

Dave
Dynamic-Table-Lookup-scaled-v6c.xlsm
0
 
Bright01Author Commented:
Dave,

Excellent!  This works very very well.  Not only that, but your documentation in the code itself makes it very easy to follow much of your logic.  You have done an outstanding job on getting this refined.  I'm going to test it now with a real case and will let you know how it goes.  I'm certain I'll have a related question but for now....again "much thanks!"

BTW;  I added a line at the top to put some headings in and it doesn't seem to have affected the code or its behavior.

Best regards,

B01
0
 
Bright01Author Commented:
Dave  did an outstanding job with this.  He stuck with this until it was complete and his documentation in the code made it easy to follow.  Great experience with a true professional!

B01
0
 
Bright01Author Commented:
Dave,

Quick one.  If you Clear the sheet, it pulls in text to the top cells (Question/Answer).  If you then move to the left, you get a error in this part of the code.

 'filter the data and drop results to outputRange
        questionSet.AdvancedFilter Action:=xlFilterCopy, criteriaRange:=MycriteriaRange, _
            CopyToRange:=outputRange, Unique:=False
       
        myCell.Offset(1, 0).Formula = holdCriteriaFormula
       
Is there a quick fix for this?

B.
0
 
Bright01Author Commented:
Dave,

As I have tested this, I have found some additional minor issues.  For some reason when I do a Clear All, I get a "Question" and "Answer" in Cells, D2 and E2.  To get it to recreate, Hit Clear All, then hit Summarize and you will see it appear.  

My other question has to do with where do I put in new data?  F through J, or in AAB through AAF or in AAL..?

Finally, take a look at AAB; the top line is repeated..... is this right?

That's all I've found as small issues..............

Can you take a look or would you like me to launch another question?

Thank you,

B.
0
 
dlmilleCommented:
I'm not sure what you mean by "clear the sheet" and "Move left".  Please describe this a bit more so I can duplicate.

I'm now looking at your next comment.

Dave
0
 
dlmilleCommented:
I fixed the case where there's nothing to report on Summarize, so no "Question/Answer" resulting in cells D2 and E2.

You load data in columns F and to the right from that.  FYI -- Range AAA and to the right is for database queries, not your data.  

AAB - the top line is indeed repeated - AAB1:AAH2 is the CRITERIA RANGE.  WHen you make selections, data appears in row 2 here, and then the query is run against that, which drops data from row 3 downward.  For the actual dropdown, the query results in range AAL1->AARwhateverrow.

So there are two types of queries - one for Questions and potentially Answers, and one for the drop down validation range filters...

Again, the Criteria for either query is the range "Criteria" - currently AAB1:AAH2, the Query results for Q/A is just below, starting in row 3, and the drop down data validation area results start in AAL1.

The neat thing about this approach is you can add new drop down validation columns or additional data from which to query and the sheet is practically all set up for that (re: using criteria and the advanced filter tool), as opposed to doing it all with arrays...

See attached, and please elaborate on "Clear the Sheet" and "Move Left" error.

Dave


Dynamic-Table-Lookup-scaled-v6d.xlsm
0
 
Bright01Author Commented:
My apologies.  And these may be more related to my mistakes as a user trying to adapt the code.

 If you select the "Clear All" button, then select "Summarize", you get "Question" and "Answer" in Cells, D2 and E2.

I also continue to get the error in this line of code:

 questionSet.AdvancedFilter Action:=xlFilterCopy, criteriaRange:=MycriteriaRange
CopyToRange:=outputRange, Unique:=False

Could it be because I hid the columns between the two data tables (actually 3) so I could try to figure out what was going on?

And it appears that starting with AAB there is a duplicate entry On Row 1 and 3;

Structured      Industry      Type      LOB      Scenario      Question      Answer
0
 
dlmilleCommented:
Did you try my last submittal.  The issue with Summarize getting Question/Answer in cells d2 and e2 is resolved.

The fields from AAB are there, by design, and should be no issue.

Do not hide columns from AAB to the right, or the queries will not execute.

Please work with the copy I submitted just two posts ago - version 6d, and advise any additional issues.

Dave
0
 
Bright01Author Commented:
OK...now working with 6d...and it looks like it works very well.   I'll let you know tomorrow.....I'm putting in several industry sets.

Thanks,

B.
0
 
Bright01Author Commented:
David,

Go to "Structured" and you will see the drop down list not display "S", but multiple "S"'s.

B.
0
 
dlmilleCommented:
Are you sure?  THere are two drop-down arrows - the one for the combobox drop down which holds unique values, and the data validation one.  The one on the far right is not for use (or a last resort if for some reason the combobox one breaks, lol).

Here - try this one, as I've turned off the other down arrow.  I don't get multiple S's, do you?

Dave
Dynamic-Table-Lookup-scaled-v6e.xlsm
0
 
Bright01Author Commented:
Dave,

I think the problem was that I renamed one or two of the headings and probably messed up some of the logic.  I brought up 6e and it works without a problem.  Thank you very much for hanging in with me and also the redesign.  I like it and think it will work nicely.  After loading the model up, I'll probably ask several related questions to modify it.  Hope you will jump in; you're a very talented person.

Thanks again,

B.
0
 
dlmilleCommented:
If you rename headings - just ensure the range- "Critiera" area has the same headings on row 1 and 3.

Dave
0

Featured Post

How to Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

  • 11
  • 9
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now