illogic
10-31-2019, 03:04 AM
Hello,
I am again having some troubles with a macro from gmayor i found here on the forums.
I have two ListBoxes in my UserForm.
The first ListBox is populated with items during Userform initialization.
The second ListBox should get its content from the selected item of the first ListBox.
The content itself is stored in a Workbook with multiple sheets each with different names and different content.
The content of each sheet is stored in Column A, but the amount of data varies from sheet to sheet.
Some sheets have content from A1:A5, others may have content from A1:A10 and so on.
I found this code and tried to make it work, but so far i fail to make the macro get the content from the sheets column range.
However it works with a single cell (A1).
Code:
Option Explicit
Private Const strWorkbook As String = "C:\artexPrüfprotokolle\Tankschutzarmaturen\Vorlagen\findingsDB.xlsx" 'The path of the workbook
Private Const strSheet1 As String = "Flammensicherung" 'The name of the worksheet (or range)
Private Const strSheet2 As String = "Ventilteller" 'The name of the worksheet (or range)
Private Const strSheet3 As String = "Ventilsitze" 'The name of the worksheet (or range)
Private Const strSheet4 As String = "Gehäuse" 'The name of the worksheet (or range)
Private Const strSheet5 As String = "Hinweise" 'The name of the worksheet (or range)
Public Sub UserForm_Initialize()
Dim gasketList, flameArresterList, ventDiscList, miscList, findingsPreSelectionList, findingsSelection As Variant
findingsPreSelectionList = Array("Flammensicherung", "Ventilteller", "Ventilsitze", "Gehäuse", "Hinweise")
ListBox5.List = findingsPreSelectionList
findingsSelection = Array(sFind)
End Sub
Private Function xlFillArray(strWorkbook As String, strRange1 As String, strRange2 As String, strRange3 As String, strRange4 As String, strRange5 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
strRange1 = strRange1 & "$]" 'Use this to work with a named worksheet
strRange2 = strRange2 & "$]" 'Use this to work with a named worksheet
strRange3 = strRange3 & "$]" 'Use this to work with a named worksheet
strRange4 = strRange4 & "$]" 'Use this to work with a named worksheet
strRange5 = strRange5 & "$]" '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 [" & strRange1, 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
Private Sub ListBox5_Click()
Dim i As Integer
Dim Arr() As Variant
Dim sFind As String
Dim TestMsg As Variant
Dim findingsSelection As Variant
For i = 0 To ListBox5.ListCount - 1
If ListBox5.Selected(i) Then
If ListBox5.List(i) = "Flammensicherung" Then
Arr = xlFillArray(strWorkbook, strSheet1, strSheet2, strSheet3, strSheet4, strSheet5)
sFind = Arr(0, 0) 'What do i need to add here to populate the Array with all content from Column A (from first to last used row).
'sFind = Arr(Cells(Rows.Count, 1).End(xlUp).Row) // This does not work (Method 'rows' for Object '_Global' failed), i don't know if this is the proper syntax (guess not).
TestMsg = sFind
MsgBox (TestMsg)
lbl_Exit:
Exit Sub
End If
End If
Next i
End Sub
This Line of Code works with a single Cell A1
But i can't get it to work with a range of cells in column A to the last used cell of that column.
sFind = Arr(0, 0) 'This works.
'sFind = Arr(Cells(Rows.Count, 1).End(xlUp).Row) // This does not work (Method 'rows' for Object '_Global' failed), i don't know if this is the proper syntax (guess not).
Does anyone know a solution to this?
I am again having some troubles with a macro from gmayor i found here on the forums.
I have two ListBoxes in my UserForm.
The first ListBox is populated with items during Userform initialization.
The second ListBox should get its content from the selected item of the first ListBox.
The content itself is stored in a Workbook with multiple sheets each with different names and different content.
The content of each sheet is stored in Column A, but the amount of data varies from sheet to sheet.
Some sheets have content from A1:A5, others may have content from A1:A10 and so on.
I found this code and tried to make it work, but so far i fail to make the macro get the content from the sheets column range.
However it works with a single cell (A1).
Code:
Option Explicit
Private Const strWorkbook As String = "C:\artexPrüfprotokolle\Tankschutzarmaturen\Vorlagen\findingsDB.xlsx" 'The path of the workbook
Private Const strSheet1 As String = "Flammensicherung" 'The name of the worksheet (or range)
Private Const strSheet2 As String = "Ventilteller" 'The name of the worksheet (or range)
Private Const strSheet3 As String = "Ventilsitze" 'The name of the worksheet (or range)
Private Const strSheet4 As String = "Gehäuse" 'The name of the worksheet (or range)
Private Const strSheet5 As String = "Hinweise" 'The name of the worksheet (or range)
Public Sub UserForm_Initialize()
Dim gasketList, flameArresterList, ventDiscList, miscList, findingsPreSelectionList, findingsSelection As Variant
findingsPreSelectionList = Array("Flammensicherung", "Ventilteller", "Ventilsitze", "Gehäuse", "Hinweise")
ListBox5.List = findingsPreSelectionList
findingsSelection = Array(sFind)
End Sub
Private Function xlFillArray(strWorkbook As String, strRange1 As String, strRange2 As String, strRange3 As String, strRange4 As String, strRange5 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
strRange1 = strRange1 & "$]" 'Use this to work with a named worksheet
strRange2 = strRange2 & "$]" 'Use this to work with a named worksheet
strRange3 = strRange3 & "$]" 'Use this to work with a named worksheet
strRange4 = strRange4 & "$]" 'Use this to work with a named worksheet
strRange5 = strRange5 & "$]" '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 [" & strRange1, 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
Private Sub ListBox5_Click()
Dim i As Integer
Dim Arr() As Variant
Dim sFind As String
Dim TestMsg As Variant
Dim findingsSelection As Variant
For i = 0 To ListBox5.ListCount - 1
If ListBox5.Selected(i) Then
If ListBox5.List(i) = "Flammensicherung" Then
Arr = xlFillArray(strWorkbook, strSheet1, strSheet2, strSheet3, strSheet4, strSheet5)
sFind = Arr(0, 0) 'What do i need to add here to populate the Array with all content from Column A (from first to last used row).
'sFind = Arr(Cells(Rows.Count, 1).End(xlUp).Row) // This does not work (Method 'rows' for Object '_Global' failed), i don't know if this is the proper syntax (guess not).
TestMsg = sFind
MsgBox (TestMsg)
lbl_Exit:
Exit Sub
End If
End If
Next i
End Sub
This Line of Code works with a single Cell A1
But i can't get it to work with a range of cells in column A to the last used cell of that column.
sFind = Arr(0, 0) 'This works.
'sFind = Arr(Cells(Rows.Count, 1).End(xlUp).Row) // This does not work (Method 'rows' for Object '_Global' failed), i don't know if this is the proper syntax (guess not).
Does anyone know a solution to this?