combobox one last push

[gringo287]

Hi,

I'm creating a categorised YouTube tutorial viewer for my work place. In order to eliminate any unnecessary searching, I have a categorised list of all the links. The user will chose the desired sheet tab and then choose from a combobox selection to view the tutorial from a WeBbrowser viewer in the worksheet.

Ive got all the pieces together now and its "ok" as is, but i have one last favour to ask. I have essentially duplicated one sheet four times and as that sheet contains a rather large image, the file size is bigger than i would like, so i would prefer to have just one sheet. one sheet means one combobox, so i need to be able to change the list that the combobox shows, dependant on a button click. Ive spent a good few hours trying to crunch this one myself but coming across obsticles with the previous list remaining when i load the next list and a few other issues. Ive searched the tinterweb, but not found what i need.

This is what i have at the moment, which as i mentioned, does work but uses four sheets and four comboboxes.


[VBA]Private Sub Workbook_Open()
Dim l As Long
Dim s As String

For l = 50 To Sheet1.Range("B65536").End(xlUp).Row
s = Sheet1.Cells(l, 1)
Sheet1.ComboBox1.AddItem (s)

Next

For l = 50 To Sheet5.Range("B65536").End(xlUp).Row
s = Sheet5.Cells(l, 1)
Sheet5.ComboBox2.AddItem (s)

Next

For l = 50 To Sheet6.Range("B65536").End(xlUp).Row
s = Sheet6.Cells(l, 1)
Sheet6.ComboBox3.AddItem (s)

Next

For l = 50 To Sheet7.Range("B65536").End(xlUp).Row
s = Sheet7.Cells(l, 1)
Sheet7.ComboBox4.AddItem (s)[/VBA]

[Kenneth Hobs]

Use the List property to fill the combobox with a range of values. I can show you how if needed.

To get the caller information for a button, see if this helps:
[vba]Private Sub CommandButton1_Click()
aControl CommandButton1.Name
End Sub

'http://www.rondebruin.nl/controlsobjectsworksheet.htm
'
Sub aControl(obj As String)
Range("A1:A3").ClearContents
Range("A1").Value = ActiveSheet.Shapes(obj).Name
Range("A2").Value = ActiveSheet.OLEObjects(obj).Object.Caption
Range("A3").Value = ActiveSheet.Shapes(obj).TopLeftCell.Address
End Sub[/vba]

Another method:
[VBA]Sub Button3_Click()
ButtonNameToA1
End Sub

Sub ButtonNameToA1()
Dim obj As OLEObject
On Error Resume Next
Range("A1").Value = Application.Caller
For Each obj In ActiveSheet.OLEObjects
'Range("A2").Value = obj.ActiveControl.Name
Next obj
Range("A2").Value = Selection.Name
End Sub[/VBA]

[gringo287]

i feel quite silly now, as this has gone over my head. are the OLEObjects, the comboboxes?. i checked out the link in the first code and it seems to refer to hiding objects. are you referring to keeping the four comboboxes but only showing the one that needed dependant on the command button click?

sorry to be a pain, but i think

Use the List property to fill the combobox with a range of values. I can show you how if needed.

is in need

[Kenneth Hobs]

I have attached an example. The code is below for those that do like like to open files. It has 3 activex command buttons and one activex combobox.

Sheet1's A10 formula is: ="Sheet1!"&CELL("address",A10) and filled down to A20. Sheet2 is the same but with that sheet name.

The union routine could be improved to be more versatile.

In sheet1's code:
[vba]Private Sub CommandButton1_Click()
FillCombobox1 CommandButton1.Name
End Sub

Private Sub CommandButton2_Click()
FillCombobox1 CommandButton2.Name
End Sub

Private Sub CommandButton3_Click()
FillCombobox1 CommandButton3.Name
End Sub

[/vba]
In Module1:
[vba]Sub FillCombobox1(cbName As String)
Dim r As Range, o As OLEObject, r2 As Range, a() As Variant

Set o = ActiveSheet.OLEObjects(cbName)
Select Case o.Name
Case "CommandButton1"
Set r = Worksheets("Sheet1").Range("A10", Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp))
Worksheets("Sheet1").ComboBox1.List = WorksheetFunction.Transpose(r)
Case "CommandButton2"
Set r = Worksheets("Sheet2").Range("A10", Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp))
Worksheets("Sheet1").ComboBox1.List = WorksheetFunction.Transpose(r)
Case "CommandButton3"
Set r = Worksheets("Sheet1").Range("A10", Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp))
Set r2 = Worksheets("Sheet2").Range("A10", Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp))
a() = UnionR2Vals(r, r2)
Worksheets("Sheet1").ComboBox1.List = a()
Case Else
End Select

Worksheets("Sheet1").ComboBox1.DropDown
End Sub

Function UnionR2Vals(r1 As Range, r2 As Range) As Variant
Dim r As Range, u() As Variant, i As Long
ReDim u(1 To r1.Cells.Count)
u() = WorksheetFunction.Transpose(r1)
ReDim Preserve u(1 To UBound(u) + r2.Cells.Count)
For i = 1 To r2.Cells.Count
u(r1.Cells.Count + i) = r2(i)
Next i
UnionR2Vals = u()
End Function
[/vba]

[gringo287]

Wow!, thats some special looking vba there. Im just working through it now. i actually need to have two columns (one for the title and one for the URL) and only want to show the title. Ill hopefully be able to work this out, but as, at the moment, im going bog-eyed looking at this, could i trouble you for a nudge in the right direction on this.

[Kenneth Hobs]

You could use a hyperlink to show the title with the url as the address as is common. Post an example workbook if you need some specific help.

The concepts that I used are fairly simple. There is not much there that is all that complicated. You could just cbName rather than o.Name to simplify it a tad.

The union routine could have been done better but I did not want to make it too complicated for you. I could do one though if I injected one more diet coke....

[gringo287]

Here goes...

Ive added a full description in the sheet. hopefully my description make sense. Thank you very much for your help so far and hopefully i wont need too many more intravenously fed diet cokes to fix my problem.

[snb]

Cfr. the attachment for probably a simpler method to populate the combobox.

It's not clear to me what should be the result in combobox1 when clicking list 3 or list 4

[gringo287]

Hi, thanks for the responses.

The four lists would be the four different catagories. I need to be able to load Combobox1 with the relevant list from the respective CommandButton(1,2,3 or 4)_click. I have no need for a Sheet2. What im hoping to achieve is have the lists based on Sheet1 eg Range ("A50:L53"). Apologies if i have made this clearer previously

[gringo287]

ok, the fog is clearing a little..

i cant seem to apply list 3 and 4??

[VBA]Private Sub CommandButton1_Click()
ComboBox1.List = Cells(10, 1).CurrentRegion.Columns(1).Value
End Sub

Private Sub CommandButton2_Click()
ComboBox1.List = Cells(10, 3).CurrentRegion.Columns(3).Value
End Sub

Private Sub CommandButton3_Click()
ComboBox1.List = Cells(10, 5).CurrentRegion.Columns(5).Value
End Sub


Private Sub CommandButton4_Click()
ComboBox1.List = Cells(10, 7).CurrentRegion.Columns(7).Value
End Sub[/VBA]


theres no point in me trying to hide that this:

[VBA]Function UnionR2Vals(r1 As Range, r2 As Range) As Variant
Dim r As Range, u() As Variant, i As Long
ReDim u(1 To r1.Cells.Count)
u() = WorksheetFunction.Transpose(r1)
ReDim Preserve u(1 To UBound(u) + r2.Cells.Count)
For i = 1 To r2.Cells.Count
u(r1.Cells.Count + i) = r2(i)
Next i
UnionR2Vals = u()
End Function[/VBA]

means very little to me. ive had zero experience with union routines

[snb]

You are probably looking for this:

[VBA]
Private Sub CommandButton1_Click()
ComboBox1.List = Cells(9, 4).CurrentRegion.Value
End Sub

Private Sub CommandButton2_Click()
ComboBox1.List = Cells(9, 7).CurrentRegion.Value
End Sub

Private Sub CommandButton3_Click()
ComboBox1.List = Cells(9, 10).CurrentRegion.Value
End Sub

Private Sub CommandButton4_Click()
ComboBox1.List = Cells(9, 13).CurrentRegion.Value
End Sub[/VBA]

[gringo287]

snb, you are a scholar and a gentleman. Thank you

[gringo287]

so that i can learn from this for next time, what is the purpose of

[VBA]Function UnionR2Vals(r1 As Range, r2 As Range) As Variant
Dim r As Range, u() As Variant, i As Long
ReDim u(1 To r1.Cells.Count)
u() = WorksheetFunction.Transpose(r1)
ReDim Preserve u(1 To UBound(u) + r2.Cells.Count)
For i = 1 To r2.Cells.Count
u(r1.Cells.Count + i) = r2(i)
Next i
UnionR2Vals = u()
End Function[/VBA]

i notice that you have left it out this time and it still works without the union routine?

[Kenneth Hobs]

Like the name says, it creates a union of two ranges from two separate sheets.

Since the ranges are in the same sheet, Union can be used. The other function does like the other in that it takes the union of areas and cells and returns a variant array.

I added another button to show you how to combine multiple ranges should you need that sometime. I also added a change event to the combobox1 to show how to get the value of the cell in the adjacent column to cell A1.

I also added a robust found routine.

[VBA]Option Explicit

Public r As Range

Sub FillCombobox1(cbName As String)
Select Case cbName
Case "CommandButton1"
Set r = Range("D9", Range("D9").End(xlDown))
Case "CommandButton2"
Set r = Range("G9", Range("G9").End(xlDown))
Case "CommandButton3"
Set r = Range("J9", Range("J9").End(xlDown))
Case "CommandButton4"
Set r = Range("M9", Range("M9").End(xlDown))
Case "CommandButton5"
Set r = Union(Range("D9", Range("D9").End(xlDown)), _
Range("G9", Range("G9").End(xlDown)), _
Range("J9", Range("J9").End(xlDown)), _
Range("M9", Range("M9").End(xlDown)))
Case Else
End Select

ActiveSheet.ComboBox1.List = rList(r)
ActiveSheet.ComboBox1.DropDown
End Sub

Function rList(aRange As Range) As Variant
Dim a() As Variant, rr As Range, c As Range, v As Variant
ReDim a(1 To aRange.Cells.Count)
Dim i As Integer

For Each rr In aRange.Areas
For Each c In r
i = i + 1
a(i) = c.Value
Next c
Next rr

rList = a()
End Function

Function FoundRanges(fRange As Range, fStr As String) As Range
Dim objFind As Range
Dim rFound As Range, FirstAddress As String

With fRange
Set objFind = .Find(what:=fStr, After:=fRange.Cells(fRange.Rows.Count, fRange.Columns.Count), _
LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=True)
If Not objFind Is Nothing Then
Set rFound = objFind
FirstAddress = objFind.Address
Do
Set objFind = .FindNext(objFind)
If Not objFind Is Nothing Then Set rFound = Union(objFind, rFound)
Loop While Not objFind Is Nothing And objFind.Address <> FirstAddress
End If
End With
Set FoundRanges = rFound
End Function
[/VBA]

In ThisWorkbook:
[VBA]Option Explicit

Private Sub ComboBox1_Change()
Dim f As Range
Set f = FoundRanges(r, ComboBox1.Value)
Range("A1").Value2 = f.Offset(0, 1).Value2
End Sub

Private Sub CommandButton1_Click()
FillCombobox1 CommandButton1.Name
End Sub

Private Sub CommandButton2_Click()
FillCombobox1 CommandButton2.Name
End Sub

Private Sub CommandButton3_Click()
FillCombobox1 CommandButton3.Name
End Sub

Private Sub CommandButton4_Click()
FillCombobox1 CommandButton4.Name
End Sub

Private Sub CommandButton5_Click()
FillCombobox1 CommandButton5.Name
End Sub[/VBA]

[gringo287]

wow, thank you, i appreciate the time you have spent here.

List5_click, seems to be failing though.

[VBA]Function rList(aRange As Range) As Variant
Dim a() As Variant, rr As Range, c As Range, v As Variant
ReDim a(1 To aRange.Cells.Count)
Dim i As Integer

For Each rr In aRange.Areas
For Each c In r
i = i + 1
a(i) = c.Value 'error
Next c
Next rr

rList = a()
End Function[/VBA]

[Kenneth Hobs]

It works for me. There is a CommandButton5_Click() from my added commandbutton example.

[gringo287]

I cant see what im doing differently to stop CommandButton5_Click() from working. im literally opening it from here and clicking the button and its failing. What i have noticed though, thats making me think that your psychic.. is that you have solved my next riddle about only having to use one cell ("A1") to show the link from the selection. I was trying to conjure up a fancy index and match function, that was getting rediculously long. Also i really like, that the list auto drops when the button is clicked.

[Kenneth Hobs]

Did you change anything in the last attachment that I posted? Most likely, it is something simple.

[snb]

[VBA]
Function rList(aRange As Range) As Variant
Dim a() As Variant, rr As Range, c As Range, v As Variant
ReDim a(1 To aRange.Cells.Count)
Dim i As Integer
For Each rr In aRange.Areas
For Each c In rr
i = i + 1
a(i) = c.Value
Next c
Next rr

rList = a()
End Function
[/VBA]

[gringo287]

Most likely, it is something simple.

ha ha, thank you snb. This Forum is amazing, you guys have been so helpful.