How Do I modify this code to look at an external file to populate the dropdown list?

[kwiat]

Hello

I have this code that work with my ribbon control, I have a dropdown box that is populated by the text in the cells from A7:A100 on the active sheet I am on. I want to set it up so it will look at an external file (file can be txt, xls..etc) stored in a folder (does not open it) and pull the values in from that file. The setup below only works when I open this workbook but I am trying to set this up as an add in in a separate tab that will be populated even if no workbooks are open. Can I somehow set the path to the file in this code?


''=========Drop Down Code =========


''Callback for Dropdown getItemCount.
''Tells Excel how many items in the drop down.

Sub DDItemCount(control As IRibbonControl, ByRef returnedVal)


With Sheet1.Range("A7:A100")
Set ListItemsRg = Range(.Cells(1), .Offset(.Rows.Count).End(xlUp))
ItemCount = ListItemsRg.Rows.Count
returnedVal = ItemCount
End With
End Sub

''Callback for dropdown getItemLabel.
''Called once for each item in drop down.
''If DDItemCount tells Excel there are 10 items in the drop down
''Excel calls this sub 10 times with an increased "index" argument each time.
''We use "index" to know which item to return to Excel.
Sub DDListItem(control As IRibbonControl, index As Integer, ByRef returnedVal)
returnedVal = ListItemsRg.Cells(index + 1).Value
''index is 0-based, our list is 1-based so we add 1.
End Sub

 

[Worf]

Hey Worf

I just test your code as an addin and it automatically opens all the templates, I need it to only open when it is selected in the dropdown and then executed as it will overload the program with too much data if there are allot of templates or logs to open.

- The data must be retrieved from the workbook where it is located. If you don´t want to open large workbooks, a solution could be to split the data into several smaller files.

it will not run unless there is a sheet in the workbook,

- The new version below does not use a range to store sheet names anymore.

The sheets are automatically opened, I want them linked to another ICON callback in the ribbon that will trigger it

- I did not understand how this new icon is supposed to work, how is the user going to select the templates, still with the dropdown? Clicking the icon should open the source file?

New code:

Option Explicit


Dim MySelectedItem$, wb As Workbook, tw As Workbook, wr As Range, i%, sna$()


''=========Drop Down Code =========, this goes at a regular module


''Callback for Dropdown getItemCount. Tells Excel how many items in drop down.


Sub DDItemCount(control As IRibbonControl, ByRef returnedVal)


'Application.ScreenUpdating = False


' inform full path
Set wb = Workbooks.Open(ThisWorkbook.Path & "\source.xlsm")
Set tw = ThisWorkbook
tw.Activate
ReDim sna(1 To wb.Sheets.Count)


For i = 1 To wb.Sheets.Count
     sna(i) = wb.Sheets(i).Name
Next


returnedVal = wb.Sheets.Count


'wb.Close False
'Set wb = Nothing
Application.ScreenUpdating = True
End Sub


''Callback for dropdown getItemLabel. Called once for each item in drop down.
''If DDItemCount tells Excel there are 10 items in the drop down
''Excel calls this sub 10 times with an increased "index" argument each time.
''We use "index" to know which item to return to Excel.


Sub DDListItem(control As IRibbonControl, index As Integer, ByRef returnedVal)
    
    returnedVal = sna(index + 1)
    ''index is 0-based, our list is 1-based so we add 1.
    
End Sub


''Drop down change handler. Called when a drop down item is selected.


Sub DDOnAction(control As IRibbonControl, ID As String, index As Integer)
Dim shname$(), twc%, mat
' Two ways to set the variable MySelectedItem to the dropdown value


MySelectedItem = sna(index + 1)         ' way 1
twc = tw.Sheets.Count


ReDim shname(1 To twc)
For i = 1 To twc
    shname(i) = tw.Sheets(i).Name
Next


' copy template to new sheet, if not already present
mat = FilterExact(shname, MySelectedItem)
If UBound(mat) = -1 Then _
    wb.Worksheets(MySelectedItem).Copy after:=tw.Sheets(twc)


'way 2 is : Call DDListItem(control, index, MySelectedItem)


End Sub


''Returns index of item to display.
Sub DDItemSelectedIndex(control As IRibbonControl, ByRef returnedVal)
    returnedVal = 0
    MySelectedItem = sna(1)
End Sub


''------- End DD Code --------


''Show the variable MySelectedItem (selected item in the dropdown)
''You can use this variable also in other macros
Sub ValueSelectedItem()


    MsgBox "The variable MySelectedItem has the value = " & MySelectedItem


End Sub


Function FilterExact(arrVariant, varSearch)
    Dim arrSearch, arrFiltered
    Const Encl$ = ":;", Delim$ = ",,"
     
    arrFiltered = Filter(arrVariant, varSearch)
    FilterExact = arrFiltered
    
    If UBound(arrFiltered) > -1 Then
      
      'Encl and Delim should not be in the array
      arrSearch = Split(Encl & Join(arrFiltered, Encl & Delim & Encl) & Encl, Delim)
      arrFiltered = Filter(arrSearch, Encl & varSearch & Encl)
      FilterExact = Split(Replace(Join(arrFiltered, Delim), Encl, ""), Delim)
      
    End If
End Function

 

[kwiat]

Hey

For the first response I guess I would create a template for each file but then it would eliminate a central file to configure all the templates.

The second response is great, it no longer requires a sheet in a workbook to open one of the templates, however; when I select the custom tab it still opens all the templates. This is good too as I could use it to set a default that opens all the templates then adds all the data the problem is when there are too many templates opened and pulling in data will it slow the system down. By having it only open the template that is selected from the dropdown it minimizes that. Secondly, the dropdown really does not provide anything in this state since it only lists the names of each template but they are all already loaded into the workbook.

The icon next to the the dropdown is there to execute opening the template selected in the dropdown and applying the settings set by the user like the date range for the data to be loaded and any highlighting of data or whatever else I would set.

Not sure if this makes any sense or not.

 

[Worf]

Hi Kwiat
I tested this as an add-in and it seems to work fine. There are three relevant objects involved:

• The installed add-in
• The source file containing the templates, stored at a hard drive
• The current workbook, to where the templates will be imported

At the custom Ribbon tab there are the dropdown and the new icon, clicking it will load what’s selected at the dropdown box.
Below are a link to the add-in and the RibbonX code, I´ll post the VBA shortly.

http://dl.dropbox.com/u/52116836/Ribbon20oct.xlam

The XML code disappeared, let me correct that at my next post...

 

[Worf]

I decide to use PHP tags although it´s XML... Looked functional at post preview:

This is getting really annoying, I even tried beforehand at "Test Here" and the script was there, guess I'll post a picture instead.

 

[Worf]

Looking good at post preview...

The Ribbon script:

The add-in code:

Option Explicit


Dim MySelectedItem$, wr As Range, i%, sna$(), wb As Workbook, tloc$


''=========Drop Down Code =========, this goes at a regular module


Sub DDOpenSelected(control As IRibbonControl)
Dim twc%, shname$(), mat, tw As Workbook, dummy$


Set tw = ActiveWorkbook
On Error Resume Next
twc = tw.Sheets.Count
If Err.Number <> 0 Then
    MsgBox "No workbooks are open..."
    Exit Sub
End If
On Error GoTo 0
ReDim shname(1 To twc)
For i = 1 To twc
    shname(i) = tw.Sheets(i).Name
Next


' copy template to new sheet, if not already present
mat = FilterExact(shname, MySelectedItem)
If UBound(mat) = -1 Then
    Application.ScreenUpdating = False
    Set wb = Workbooks.Open(tloc)
    wb.Worksheets(MySelectedItem).Copy after:=tw.Sheets(twc)
    CleanUp
End If
End Sub


Sub DDItemCount(control As IRibbonControl, ByRef returnedVal)


'for getItemCount,tells Excel how many items in drop down.
tloc = "c:\accounts\source.xlsm"
Application.ScreenUpdating = False


Set wb = Workbooks.Open(tloc)   ' inform full path of template file here
ReDim sna(1 To wb.Sheets.Count)


For i = 1 To wb.Sheets.Count
     sna(i) = wb.Sheets(i).Name
Next


returnedVal = wb.Sheets.Count
CleanUp
End Sub


Sub CleanUp()
    wb.Close False
    Set wb = Nothing
    Application.ScreenUpdating = True
End Sub


''Callback for dropdown getItemLabel. Called once for each item in drop down.
''If DDItemCount tells Excel there are 10 items in the drop down
''Excel calls this sub 10 times with an increased "index" argument each time.
''We use "index" to know which item to return to Excel.


Sub DDListItem(control As IRibbonControl, index As Integer, ByRef returnedVal)
    
    returnedVal = sna(index + 1)
    ''index is 0-based, our list is 1-based so we add 1.
    
End Sub


''Drop down change handler. Called when a drop down item is selected.


Sub DDOnAction(control As IRibbonControl, ID As String, index As Integer)


    MySelectedItem = sna(index + 1)


End Sub


''Returns index of item to display.
Sub DDItemSelectedIndex(control As IRibbonControl, ByRef returnedVal)
    returnedVal = 0
    MySelectedItem = sna(1)
End Sub


''------- End DD Code --------


''Show the variable MySelectedItem (selected item in the dropdown)
''You can use this variable also in other macros
Sub ValueSelectedItem()


    MsgBox "The variable MySelectedItem has the value = " & MySelectedItem


End Sub




Function FilterExact(arrVariant, varSearch)
    Dim arrSearch, arrFiltered
    Const Encl$ = ":;", Delim$ = ",,"
     
    arrFiltered = Filter(arrVariant, varSearch)
    FilterExact = arrFiltered
    
    If UBound(arrFiltered) > -1 Then
      
      'Encl and Delim should not be in the array
      arrSearch = Split(Encl & Join(arrFiltered, Encl & Delim & Encl) & Encl, Delim)
      arrFiltered = Filter(arrSearch, Encl & varSearch & Encl)
      FilterExact = Split(Replace(Join(arrFiltered, Delim), Encl, ""), Delim)
      
    End If
End Function