Would there be anyone out there that could point me in the right direction with a system I am making within vba (excel based).
I currently have a userform with a multi col listbox selection, the listbox is populated from the database. But when you go to select the item on the listbox it only shows the first col. How would I be able to make it so it showed the first and seconded col. Please see below images
form_create_order.Controls("cmb_product_category").Enabled = True
Dim Connection As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim rcArray As Variant
Dim sSQL As String
With Connection
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = DatabaseLocation
.Properties("Jet OLEDB:Database Password") = ProtectPassword
.Open
End With
sSQL = "SELECT ID, Category_Name " & _
"FROM Category_Database ORDER BY Category_Name;"
rst.Open sSQL, Connection
rcArray = rst.GetRows
With form_create_order.cmb_product_category
.Clear
.ColumnCount = 2
.List = Application.Transpose(rcArray)
.ListIndex = -1
End With
rst.Close
Connection.Close
Set rst = Nothing
Set Connection = Nothing
For the sake of giving alternatives (found here):
Private Sub ComboBox1_Click()
With ComboBox1
.Text = .List(.ListIndex, 0) & " | " & .List(.ListIndex, 1)
End With
End Sub
No need for columnwidth in this case (however, that is a more elegant way).
I'd suggest to follow the MSDN documentation: How to: Change the Column Widths of a Multi-Column List Box
ListBox1.ColumnWidths="0;500" 'replace `;` with `,` if your system uses commas as a separator
[EDIT]
Accordingly to PEH comment, you can use:
ListBox1.ColumnWidths = Replace$("0;500", ";", Application.International(xlListSeparator))
if you're looking for more flexible solution, independent of regional settings.
Related
I have a data connection in my xlsm file, which is called "DATA".
I created my combo box and input the value from a range.
Now I need to return a result set based on the value from the combo box (drop down list). e.g. if the value in the dropdown list is "CompanyXYZ", then my query from "DATA" needs to be returned but only the data for CompanyXYZ.
The sql equivalent is:
"SELECT * FROM [query] where [column] = combobox
Issue #1
Below is my sheet("DATA"). It has a table returned by the SQL query. One of the columns is Debtor_Name. It has more than 8500 rows but only 90 are unique.
In my other sheet, I have an ActiveX ComboBox that needs to return all the unique values from DATA.Debtor_name column (the 90 unique values).
Sample VBA for issue #1:
Sub Populate_Combobox_Worksheet()
'The Excel workbook and worksheets that contain the data, as well as the range placed on that data
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnData As Range
'Variant to contain the data to be placed in the combo box.
Dim vaData As Variant
'Initialize the Excel objects
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("DATA")
'Set the range equal to the data, and then (temporarily) copy the unique values of that data to the L column.
With wsSheet
Set rnData = .Range(.Range("D1"), .Range("D10000").End(xlUp))
rnData.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Range("X1"), _
Unique:=True
'store the unique values in vaData
vaData = .Range(.Range("X2"), .Range("X10000").End(xlUp)).Value
'clean up the contents of the temporary data storage
.Range(.Range("X1"), .Range("X10000").End(xlUp)).ClearContents
End With
'display the unique values in vaData in the combo box already in existence on the worksheet.
With wsSheet.OLEObjects("ComboBox1").Object
.Clear
.List = vaData
.ListIndex = -1
End With
End Sub
Issue #2.
Now the end user will need to select a debtor_name from the combo box, then click on refresh data. This DATA REFRESH will need to only pull the data from SQL where debtor_name = [selected value in combo box]
I asked about for issue #2 because I did not know I had an issue with my combo box (issue #1); however, I can handle that somehow; only need help with issue #2 now.
You can use SQL to populate the ComboBox with unique values.
Option Explicit
Sub Populate_Combobox_Worksheet()
Dim con As ADODB.Connection, rs As ADODB.Recordset, SQL As String
Set con = GetConnection
' query
SQL = " SELECT DISTINCT [Debtor_name] FROM [DATA$]" & _
" WHERE [Debtor_name] IS NOT NULL" & _
" ORDER BY [Debtor_Name]"
Set rs = con.Execute(SQL)
With Sheet2.ComboBox1
.Clear
.List = Application.Transpose(rs.GetRows)
.ListIndex = -1
End With
con.Close
End Sub
Sub RefreshData()
Dim con As ADODB.Connection, rs As ADODB.Recordset, SQL As String
Set con = GetConnection
' query
SQL = " SELECT * FROM [DATA$]" & _
" WHERE [Debtor_name] = '" & Sheet2.ComboBox1.Value & "'"
Set rs = con.Execute(SQL)
Sheet2.Range("A1").CopyFromRecordset rs
con.Close
End Sub
Function GetConnection() As ADODB.Connection
Dim wb As Workbook, sCon As String
Set wb = ThisWorkbook
sCon = "Data Source=" & wb.FullName & "; " & _
"Extended Properties=""Excel 12.0;HDR=Yes;"";"
' connect
Set GetConnection = New ADODB.Connection
With GetConnection
.Provider = "Microsoft.ACE.OLEDB.12.0;"
.ConnectionString = sCon
.Open
End With
End Function
I Need to populate many combo boxes with the same table. In the code at the line with Me.cobobox3 I need to add many other combo boxes but have no idea how.
'Load Employee Number in List Box
Dim cn1 As New ADODB.Connection
Dim rt1 As New ADODB.Recordset
'Opening a connection to the database
dbPath = Sheets("Info").Range("a3").Value
cn1.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
'Getting Data from database
rt1.Open "SELECT * FROM EmployeeTypes", cn1, adOpenStatic
rt1.MoveFirst
'Setting where to show the Employee Record
With Me.ComboBox3
.Clear
Do
.AddItem rt1![EmpType]
rt1.MoveNext
Loop Until rt1.EOF
End With
You could create an Array of ComboBoxes:
Dim Combos(1) as ComboBox 'replace 1 with the number of your comboboxes
Set Combos(0) = yourFirstComboBox
Set Combos(1) = yourSecondComboBox
' ...
For Each cb in Combos
With cb
.Clear
Do
.AddItem rt1![EmpType]
rt1.MoveNext
Loop Until rt1.EOF
End With
Next cb
I have been looking for a solution to inserting data into excel using vb6 code and access database. There are many cases where I need to write to an excel spreadsheet multiple times with different records of data. I have an existing workbook that I am trying to open and "save as" when I am complete. I have been able to open the excel workbook, access the sheet I am writing to, and the cells I am writing to, however I can only write to the workbook once and when I leave the scope of the open workbook the connection is closed.
I have a sub routine that creates the workbook object, opens the existing workbook and work sheet, writes to a specified cell number to insert the new data. I have looked at official support pages and it doesn't seem to have what I am looking for at this time.
Am I making this too complicated or is there a solution for this? Please help.
My current code:
Row Arrays
Private oldDataRowArray(3 To 21) As Integer
Private updatedDataRowArray(5 To 2) As Integer
Loop logic
Dim i As Integer
Dim n As Integer
i = 3
n = 5
Do While i <= UBound(oldDataRowArray) And n <= UBound(updatedDataRowArray)
EditExcelSheet txtWorkbookFileName.Text, i, n //sub routine
i = i + 3 //skip number of cells
n = n + 3 //skip number of cells
Loop
Sub Routine to Insert data into Excel
Private Sub EditStakingSheet(ByVal workbook As String, ByVal oldDataRowIndex As Integer, ByVal newDataRowIndex As Integer)
Dim objExcel As Object
Dim objWorkBook As Object
Dim objSheet As Object
Set objExcel = New Excel.Application
Set objWorkBook = objExcel.Workbooks.Open(workbook)
Set objSheet = objWorkBook.Worksheets(1)
objExcel.Visible = True
//insert old value
objSheet.Cells(oldDataRowIndex , 26).Value = "old Value"
//insert new value
objSheet.Cells(newDataRowIndex , 26).Value = "new Value"
End Sub
You could use adodb objects.
This video is a good tutorial for this.
Here is an example how you can use adodb. You need to install the activeX Data Objects Libary for this.
For .source= you can use any sql-query.
Public Function get_Value(table As String, order_by As String) As Variant
Set db_data = New ADODB.Recordset
Set db1 = New ADODB.Connection
pDB_path = "#enter db-path here"
db1.ConnectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & pDB_path & ";Persist Security Info=False;"
db1.Open
With db_data
.ActiveConnection = db1
.Source = "SELECT * FROM " & table & " ORDER BY " & order_by & " ASC"
.LockType = adLockReadOnly 'read only access to db
.CursorType = adOpenStatic 'how to update the database
.Open
End With
get_Value = TransposeArray(db_data.GetRows)
db_data.Close
End Function
Due to compatibility issues, I am having to use an Excel form control listbox (vs. ActiveX) control on my spreadsheet. I am trying to populate it with three fields from an ADO recordset, but I am having problems as it has been sometime since I have used Form Controls.
Here is the code I wrote for my ActiveX listbox. Can you point me to an example of where a form control listbox with multiple columns is populated from an ADO recordset?
Thanks ahead of time for any help you can provide in making this conversion!
-- Tom
Private Sub Worksheet_Activate()
On Error GoTo Err_Worksheet_Activate
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim i As Integer
Set cnn = New ADODB.Connection
cnn.ConnectionString = gcstr_Connection ' a global property with the connection string defined elsewhere. The connection is to a SQL Server database.
cnn.Open
Set rst = cnn.Execute("SELECT [FieldA], [FieldB], [FieldC] FROM dbo.", , adCmdText)
rst.MoveFirst
With Me.lst_System
.Clear
Do
.AddItem
.List(i, 0) = rst![FieldA]
.List(i, 1) = rst![FieldB]
.List(i, 2) = rst![FieldC]
i = i + 1
rst.MoveNext
Loop Until rst.EOF
End With
Exit_Worksheet_Activate:
On Error Resume Next
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
Exit Sub
Err_Worksheet_Activate:
MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
Err.Clear
Resume Exit_Worksheet_Activate
End Sub
No idea if Form control can support muticolumns like the ActiveX list box so you might need to consider adding them in differently..
Below is an example of how to remove all/add items, hope it helps:
'to remove all previous items
Me.Shapes("lst_System").ControlFormat.RemoveAllItems
'to add item
Me.Shapes("lst_System").ControlFormat.AddItem "SomeStringValue"
I know it's not recommended but my hands are tied so I have to use this for now (as a patch until I fix the database)
I am in a multi-user environment. The data is on Access and they need to access it to update some information so other department can pull reports and use the newly updated data.
Fairly simple, however, the database wasn't maintained for over 6 months, the infrastructure was bad from the beginning but I can't afford to refactor now.
I have create a userform on Excel where I can update, modify info on sheets. I want to be able to pull the information from access into the excel sheets, and show a userform to the different users, they will update what they have to update and upon closing the userform, the access record they were working on will be updated.
I haven't find any solution for that. I seemed to have find something with DAO but I'm not sure.
Here is a super crude example of how to use a userform to write sql. Make sure you have the correct references.
Private Sub CommandButton1_Click()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim tdf As DAO.TableDef
Dim vAr$
Dim arrResults(2) As String
For Each tdf In db.TableDefs
If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*") Then
tdf.RefreshLink
End If
Next
Set db = DBEngine.OpenDatabase("C:\Users\Ashleysaurus\Desktop" & "\" & "xyzmanu3.accdb")
vAr = TextBox1.Value
Set rst = db.OpenRecordset("SELECT PartName, PartNum, Quantity FROM InventoryTbl WHERE PartName='" & vAr & "';")
i = 0
rst.MoveFirst
Do Until rst.EOF
arrResults(i) = rst.Fields(0)
arrResults(i) = rst.Fields(1)
arrResults(i) = rst.Fields(2)
rst.MoveNext
i = i + 1
Loop
TextBox2.Value = arrResults(0)
TextBox3.Value = arrResults(1)
TextBox4.Value = arrResults(2)
Set tdf = Nothing
rst.Close
Set rst = Nothing
db.Close
Set db = Nothing
End Sub
Private Sub CommandButton2_Click()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim vAr$: vAr = TextBox1.Value
Dim vAr2$: vAr2 = TextBox2.Value
Dim vAr3$: vAr3 = TextBox3.Value
Dim vAr4$: vAr4 = TextBox4.Value
Dim vbSql$
For Each tdf In db.TableDefs
If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*") Then
tdf.RefreshLink
End If
Next
Set db = DBEngine.OpenDatabase("C:\Users\Ashleysaurus\Desktop" & "\" & "xyzmanu3.accdb")
vbSql = "UPDATE InventoryTbl SET PartName='" & vAr2 & ", Quantity='" & vAr4 & " WHERE PartNum='" & vAr3 & "';"
db.Execute vbSql
Set tdf = Nothing
db.Close
Set db = Nothing
End Sub
Button1 retrieves the data, stores into an array and then dumps contents into textboxes. Button two takes contents from textboxes and then up;dates the tables based off of that.
Since this isn't a script writing service, you should be able to tinker your way into what you're looking for off of this.