Hello,
sorry for resurrecting this two year old thread, but it kind of relates to a problem i am having with my userform.
I have two listboxes in my userform 'frmFindings', 'ListBox5' and 'ListBox6'.
ListBox5 ist populated with a fixed set of items when the userform gets initialized.
Public Sub UserForm_Initialize()
Dim findingsPreSelectionList As Variant
findingsPreSelectionList = Array("Item1", "Item2", "Item3", "Item4", "Item5")
ListBox5.List = findingsPreSelectionList
End Sub
I created a excel document which i want to use as a database for ListBox6.
The excel document consists of several worksheets relating to the ListBox5 items (item1, item2, item3, item4, item5).
Each sheet has a set of data (long texts) written in Column A (A1, A2, A3...) with a variable range.
The number of rows/cells in Column A that contain information varies from sheet to sheet and may change later on.
I want it to be extensible without making to many adjustments to the code if possible.
When the user selects an item from ListBox5 like Item2 or Item4 and so on, then ListBox6 should show the content from that related excel sheet.
Private Sub ListBox5_Click()
Dim i As Integer
For i = 0 To ListBox5.ListCount - 1
If ListBox5.Selected(i) Then
If ListBox5.List(i) = "Item1" Then
'The ListBox6 should show the items from the excel workbook with sheetname "Item1"
End If
If ListBox5.List(i) = "Item2" Then
'The ListBox6 should show the items from the excel workbook with sheetname "Item2"
End If
'...
End If
Next i
End Sub
I stumbled upon this thread while searching the internet for a solution on how to do this.
Is it possible with your Code to achieve my goal?
How do i need to set this up to work with multiple sheets, with different names and variable datacount.
Option Explicit
Private Const strWorkbook As String = "E:\Path\ConfigFile.xlsx" 'The path of the workbook
Private Const strSheet As String = "Bookmarks" 'The name of the worksheet (or range) '
Sub Test()
Dim Arr() As Variant
Dim sFind As String
Arr = xlFillArray(strWorkbook, strSheet)
sFind = Arr(0, 0) 'cell A1
MsgBox sFind
lbl_Exit:
Exit Sub
End Sub
Private Function xlFillArray(strWorkbook As String, _
strRange As String) As Variant
'Graham Mayor - http://www.gmayor.com - 24/09/2016
Dim RS As Object
Dim CN As Object
Dim iRows As Long
strRange = strRange & "$]" 'Use this to work with a named worksheet
'strRange = strRange & "]" 'Use this to work with a named range
Set CN = CreateObject("ADODB.Connection")
'Set HDR=YES for a sheet or range with a header row
CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkbook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=NO"";"
Set RS = CreateObject("ADODB.Recordset")
RS.Open "SELECT * FROM [" & strRange, CN, 2, 1
With RS
.MoveLast
iRows = .RecordCount
.MoveFirst
End With
xlFillArray = RS.GetRows(iRows)
If RS.State = 1 Then RS.Close
Set RS = Nothing
If CN.State = 1 Then CN.Close
Set CN = Nothing
lbl_Exit:
Exit Function
End Function
Any help would be appreciated!
best regards
Manuel