Darren Smith
Well-known Member
- Joined
- Nov 23, 2020
- Messages
- 631
- Office Version
- 2019
- Platform
- Windows
This needs to select 2 Columns in Access. Column Names are Vehicle and HeightAndWidthGantry then filter by Vehicle Type.
To return the HeightAndWidthGantry Value.
This bit should select 2 Columns out of 10 in Access database Sheet
To return the HeightAndWidthGantry Value.
This bit should select 2 Columns out of 10 in Access database Sheet
VBA Code:
Source = "SELECT *FROM [GantryHeight&Width] " & _
" WHERE [Vehicle]='" & Model_Type.Text & "'"
VBA Code:
Private Sub Model_Type_Change()
TurnOff
With ThisWorkbook.Worksheets("Quote Detail")
.ListObjects("Quote_Detail").AutoFilter.ShowAllData
Me.WBase.Text = "Wheel Base"
Me.Vehicle_Cab_Type.Text = "Cab Type"
Me.Drivetrain.Text = "Drivetrain"
Me.Rear_Wheels.Text = "Rear Wheels"
If Me.Model_Type.Value <> "Model Type" Then _
.ListObjects("Quote_Detail").Range.AutoFilter Field:=1, Criteria1:=Me.Model_Type.Value
End With
UpdateLists
Dim DBFullName As String
Dim Connect As String, Source As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Integer
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("GantryID")
ws.Range("A2:C5").ClearContents
DBFullName = "\\TGS-SRV01\Share\ShopFloor\PRODUCTION\DLS Cardworker\Access Files\DrNo Data Base.accdb"
Set Connection = New ADODB.Connection
Connect = "Provider=Microsoft.ACE.OLEDB.12.0;"
Connect = Connect & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Connect
Set Recordset = New ADODB.Recordset
With Recordset
Source = "SELECT *FROM [GantryHeight&Width] " & _
" WHERE [Vehicle]='" & Model_Type.Text & "'"
.Open Source:=Source, ActiveConnection:=Connection
MsgBox "The Query:" & vbNewLine & vbNewLine & Source
For Col = 0 To Recordset.Fields.Count - 1
ws.Range("A1").Offset(0, Col).Value = Recordset.Fields(Col).Name
Next
ws.Range("A1").Offset(1, 0).CopyFromRecordset Recordset
End With
ws.Columns.AutoFit
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing
TurnOn
End Sub