waiting for user response

M

Michelle

Hi,
I have a form in excel that contains 4 combo boxes that the user can fill in
to drill down to pull up an existing record in a table. As the user selects
from the combo box it narrows his selection criteria from his selections. For
Example; the first field is Project Number. I fill the combo box with all
projects. The user selects project number 1. Then I write all the project 1's
into a temptable in Access. The second field is EquipCOA. I now want to go to
the temp table in Access and from the project 1 records I want to pull all
the EquipCoa's for project 1 to put in the combo box. Then the user can
select what EquipCOA they want. then the next combo box is VendID. I fill the
combo box with selection criteria from the temptable that is filtered by
project 1 and the EquipCoa that was selected.
The problem is I can't get the timing on my code right to fill up the combo
box for the second EquipCOA selection. Can you help me? Below is my code.

Sub PopulateExistingBWProjectNumber()

Dim i As Integer
Range("BWProjectNumber").Select

'Create Connection String

Set UsageTracking = New ADODB.Connection
With UsageTracking
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With


Application.EnableEvents = True
'If cboEquipmentCOA.Value <> "" Then
'frmDSRHeader.cboCustomerName.Visible = True



Set adoRecordset = New ADODB.Recordset
adoRecordset.Open _
Source:="SELECT DISTINCT tblDSREquipment.BWProjectNumberID,
tblProjectData.BWProjectNumber, tblProjectData.BWProjectName FROM
tblProjectData INNER JOIN tblDSREquipment ON
(tblDSREquipment.BWProjectNumberID) = (tblProjectData.BWProjectNumberID)", _
ActiveConnection:=UsageTracking, _
CursorType:=adOpenStatic, _
LockType:=adLockReadOnly, _
Options:=adCmdText
adoRecordset.MoveFirst


With frmDSRHeader.cboBWProjectNumber
.Clear
.ColumnCount = 3
.BoundColumn = 1
.ColumnWidths = "0;72;216"

Do
.AddItem
.List(i, 0) = adoRecordset![BWProjectNumberID]
.List(i, 1) = adoRecordset![BWProjectNumber]
.List(i, 2) = adoRecordset![BWProjectName]
i = i + 1
adoRecordset.MoveNext
Loop Until adoRecordset.EOF
End With

frmDSRHeader.cboEquipmentCOA.Enabled = True
Application.EnableEvents = True
'Load frmDSRHeader
frmDSRHeader.Show

WriteProjectRecords 'modExistingDSRValues


Set adoRecordset = Nothing
UsageTracking.Close
Set UsageTracking = Nothing

End Sub

Sub WriteProjectRecords()

Dim db1 As ADODB.Connection
Dim db2 As ADODB.Connection
Dim adoRecordset As ADODB.Recordset
Dim RecordsetTemp As ADODB.Recordset
Dim strSQL As String

'select records from tblDSREquipment and write to database.

'First connection to collect records
Set db1 = New ADODB.Connection
With db1
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With

Application.EnableEvents = False
'cboBWProjectNumber.SetFocus
'If cboEquipmentCOA.Value <> "" Then
'frmDSRHeader.cboCustomerName.Visible = True

Debug.Print intDSRProjectNumber

strSQL = "SELECT tblDSREquipment.DSREquipmentID,
tblDSREquipment.BWProjectNumberID, tblDSREquipment.VendID,
tblDSREquipment.COAID, tblDSREquipment.EquipmentShipDate,
tblDSREquipment.POReleaseDate, tblDSREquipment.DSRCreateDate,
tblDSREquipment.DSRDocumentNumber, tblDSREquipment.DSRDocumentRevision,
tblDSREquipment.SystemPartPolicy, tblDSREquipment.ReleaseIndicator,
tblDSREquipment.EText, tblDSREquipment.LifecycleState, tblDSREquipment.UOM,
tblDSREquipment.PartBLSCreated, tblProjectData.BWProjectNumber,
tblProjectData.BWProjectName " & _
"FROM tblProjectData INNER JOIN tblDSREquipment ON
tblProjectData.BWProjectNumberID=tblDSREquipment.BWProjectNumberID " & _
"WHERE (((tblDSREquipment.BWProjectNumberID)=1)) " & _
"ORDER BY tblDSREquipment.DSREquipmentID,
tblDSREquipment.BWProjectNumberID ;"

Set adoRecordset = New ADODB.Recordset
adoRecordset.CursorType = adOpenStatic
adoRecordset.LockType = adLockReadOnly
adoRecordset.Open strSQL, db1, adOpenKeyset

Debug.Print strSQL


'WhereStr = "WHERE (((tblDSREquipment.BWProjectNumberID)= ' &
intDSRProjectNumber & '))"

'Write to UsageTracking/tblDSRSelectProject
'Second connection to write records
Set db2 = New ADODB.Connection
With db2
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With

Set RecordsetTemp = New ADODB.Recordset
RecordsetTemp.CursorType = adOpenDynamic
RecordsetTemp.LockType = adLockPessimistic
RecordsetTemp.Open "Select * from tblDSRSelectProject", db2, adOpenKeyset

With RecordsetTemp
Do
RecordsetTemp.AddNew
.Fields(1) = adoRecordset(1) 'BWProjectNumberID
.Fields(2) = adoRecordset(2) 'VendID
.Fields(3) = adoRecordset(3) 'COAID
.Fields(4) = adoRecordset(4) 'EquipmentShipDate
.Fields(5) = adoRecordset(5) 'POReleaseDate
.Fields(6) = adoRecordset(6) 'DSRCreateDate
.Fields(7) = adoRecordset(7) 'DSRDocumentNumber
.Fields(8) = adoRecordset(8) 'DSRDocumentRevision
.Fields(9) = adoRecordset(9) 'SystemPartPolicy
.Fields(10) = adoRecordset(10) 'ReleaseIndicator
.Fields(11) = adoRecordset(11) 'EText
.Fields(12) = adoRecordset(12) 'LifecycleState
.Fields(13) = adoRecordset(13) 'UOM
.Fields(14) = adoRecordset(14) 'PartBLSCreated
.Fields(15) = adoRecordset(15) 'BWProjectNumber
.Fields(16) = adoRecordset(16) 'BWProjectName

RecordsetTemp.Update
adoRecordset.MoveNext
Loop Until adoRecordset.EOF
End With

Set RecordsetTemp = Nothing
Set adoRecordset = Nothing
db1.Close
db2.Close
Set db1 = Nothing
Set db2 = Nothing

PopulateExistingEquipmentCOA

End Sub


Sub PopulateExistingEquipmentCOA()

Dim i As Integer
Dim db2 As ADODB.Connection

'Create Connection String

Set UsageTracking = New ADODB.Connection
With UsageTracking
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With


Application.EnableEvents = True
'If cboEquipmentCOA.Value <> "" Then
'frmDSRHeader.cboCustomerName.Visible = True

Set adoRecordset = New ADODB.Recordset
adoRecordset.Open _
Source:="SELECT DISTINCT tblDSRSelectProject.COAID, [Code of
Accounts].COA, [Code of Accounts].Description FROM [Code of Accounts] INNER
JOIN tblDSRSelectProject ON (tblDSRSelectProject.COAID) = ([Code of
Accounts].COAID)", _
ActiveConnection:=db2, _
CursorType:=adOpenStatic, _
LockType:=adLockReadOnly, _
Options:=adCmdText
adoRecordset.MoveFirst

With frmDSRHeader.cboEquipmentCOA
.Clear
.ColumnCount = 3
.BoundColumn = 1
.ColumnWidths = "0;50;216"

Do
.AddItem
.List(i, 0) = adoRecordset![COAID]
.List(i, 1) = adoRecordset![COA]
.List(i, 2) = adoRecordset![Description]
i = i + 1
adoRecordset.MoveNext
Loop Until adoRecordset.EOF
End With

Set adoRecordset = Nothing
UsageTracking.Close
Set UsageTracking = Nothing


End Sub
 
P

Patrick Molloy

for this demo, i have three listboxes. basically they have much of the same
functionality of the combobox except you can see all the items

the idea is that listbox1 clears boxes 2 and 3, while listbox2 causes box 3
to clear. the data shows how the value cascade through.
listbox1 simply has letters from B thro K
clicking a letter loads listbox2 with ten items 'n'1 thro 10 where n is the
letter selected and listbox3 remains empty.
similarly, listbox3 is populated when an item in listbox2 is selected.

I didn't put code in listbox3, but this is where your final filter would
retrieve your report from the database


Option Explicit
Dim i As Long

Private Sub ListBox1_Click()
ListBox2.Clear
ListBox3.Clear
For i = 1 To 10
ListBox2.AddItem ListBox1.Value & i
Next
End Sub

Private Sub ListBox2_Click()
ListBox3.Clear
For i = 1 To 10
ListBox3.AddItem ListBox2.Value & ":" & i
Next

End Sub

Private Sub ListBox3_Click()
'nothing
End Sub

Private Sub UserForm_Initialize()
For i = 1 To 10
ListBox1.AddItem Chr(65 + i)
Next
End Sub



Michelle said:
Hi,
I have a form in excel that contains 4 combo boxes that the user can fill
in
to drill down to pull up an existing record in a table. As the user
selects
from the combo box it narrows his selection criteria from his selections.
For
Example; the first field is Project Number. I fill the combo box with all
projects. The user selects project number 1. Then I write all the project
1's
into a temptable in Access. The second field is EquipCOA. I now want to go
to
the temp table in Access and from the project 1 records I want to pull all
the EquipCoa's for project 1 to put in the combo box. Then the user can
select what EquipCOA they want. then the next combo box is VendID. I fill
the
combo box with selection criteria from the temptable that is filtered by
project 1 and the EquipCoa that was selected.
The problem is I can't get the timing on my code right to fill up the
combo
box for the second EquipCOA selection. Can you help me? Below is my code.

Sub PopulateExistingBWProjectNumber()

Dim i As Integer
Range("BWProjectNumber").Select

'Create Connection String

Set UsageTracking = New ADODB.Connection
With UsageTracking
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With


Application.EnableEvents = True
'If cboEquipmentCOA.Value <> "" Then
'frmDSRHeader.cboCustomerName.Visible = True



Set adoRecordset = New ADODB.Recordset
adoRecordset.Open _
Source:="SELECT DISTINCT tblDSREquipment.BWProjectNumberID,
tblProjectData.BWProjectNumber, tblProjectData.BWProjectName FROM
tblProjectData INNER JOIN tblDSREquipment ON
(tblDSREquipment.BWProjectNumberID) = (tblProjectData.BWProjectNumberID)",
_
ActiveConnection:=UsageTracking, _
CursorType:=adOpenStatic, _
LockType:=adLockReadOnly, _
Options:=adCmdText
adoRecordset.MoveFirst


With frmDSRHeader.cboBWProjectNumber
.Clear
.ColumnCount = 3
.BoundColumn = 1
.ColumnWidths = "0;72;216"

Do
.AddItem
.List(i, 0) = adoRecordset![BWProjectNumberID]
.List(i, 1) = adoRecordset![BWProjectNumber]
.List(i, 2) = adoRecordset![BWProjectName]
i = i + 1
adoRecordset.MoveNext
Loop Until adoRecordset.EOF
End With

frmDSRHeader.cboEquipmentCOA.Enabled = True
Application.EnableEvents = True
'Load frmDSRHeader
frmDSRHeader.Show

WriteProjectRecords 'modExistingDSRValues


Set adoRecordset = Nothing
UsageTracking.Close
Set UsageTracking = Nothing

End Sub

Sub WriteProjectRecords()

Dim db1 As ADODB.Connection
Dim db2 As ADODB.Connection
Dim adoRecordset As ADODB.Recordset
Dim RecordsetTemp As ADODB.Recordset
Dim strSQL As String

'select records from tblDSREquipment and write to database.

'First connection to collect records
Set db1 = New ADODB.Connection
With db1
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With

Application.EnableEvents = False
'cboBWProjectNumber.SetFocus
'If cboEquipmentCOA.Value <> "" Then
'frmDSRHeader.cboCustomerName.Visible = True

Debug.Print intDSRProjectNumber

strSQL = "SELECT tblDSREquipment.DSREquipmentID,
tblDSREquipment.BWProjectNumberID, tblDSREquipment.VendID,
tblDSREquipment.COAID, tblDSREquipment.EquipmentShipDate,
tblDSREquipment.POReleaseDate, tblDSREquipment.DSRCreateDate,
tblDSREquipment.DSRDocumentNumber, tblDSREquipment.DSRDocumentRevision,
tblDSREquipment.SystemPartPolicy, tblDSREquipment.ReleaseIndicator,
tblDSREquipment.EText, tblDSREquipment.LifecycleState,
tblDSREquipment.UOM,
tblDSREquipment.PartBLSCreated, tblProjectData.BWProjectNumber,
tblProjectData.BWProjectName " & _
"FROM tblProjectData INNER JOIN tblDSREquipment ON
tblProjectData.BWProjectNumberID=tblDSREquipment.BWProjectNumberID " & _
"WHERE (((tblDSREquipment.BWProjectNumberID)=1)) " & _
"ORDER BY tblDSREquipment.DSREquipmentID,
tblDSREquipment.BWProjectNumberID ;"

Set adoRecordset = New ADODB.Recordset
adoRecordset.CursorType = adOpenStatic
adoRecordset.LockType = adLockReadOnly
adoRecordset.Open strSQL, db1, adOpenKeyset

Debug.Print strSQL


'WhereStr = "WHERE (((tblDSREquipment.BWProjectNumberID)= ' &
intDSRProjectNumber & '))"

'Write to UsageTracking/tblDSRSelectProject
'Second connection to write records
Set db2 = New ADODB.Connection
With db2
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With

Set RecordsetTemp = New ADODB.Recordset
RecordsetTemp.CursorType = adOpenDynamic
RecordsetTemp.LockType = adLockPessimistic
RecordsetTemp.Open "Select * from tblDSRSelectProject", db2,
adOpenKeyset

With RecordsetTemp
Do
RecordsetTemp.AddNew
.Fields(1) = adoRecordset(1) 'BWProjectNumberID
.Fields(2) = adoRecordset(2) 'VendID
.Fields(3) = adoRecordset(3) 'COAID
.Fields(4) = adoRecordset(4) 'EquipmentShipDate
.Fields(5) = adoRecordset(5) 'POReleaseDate
.Fields(6) = adoRecordset(6) 'DSRCreateDate
.Fields(7) = adoRecordset(7) 'DSRDocumentNumber
.Fields(8) = adoRecordset(8) 'DSRDocumentRevision
.Fields(9) = adoRecordset(9) 'SystemPartPolicy
.Fields(10) = adoRecordset(10) 'ReleaseIndicator
.Fields(11) = adoRecordset(11) 'EText
.Fields(12) = adoRecordset(12) 'LifecycleState
.Fields(13) = adoRecordset(13) 'UOM
.Fields(14) = adoRecordset(14) 'PartBLSCreated
.Fields(15) = adoRecordset(15) 'BWProjectNumber
.Fields(16) = adoRecordset(16) 'BWProjectName

RecordsetTemp.Update
adoRecordset.MoveNext
Loop Until adoRecordset.EOF
End With

Set RecordsetTemp = Nothing
Set adoRecordset = Nothing
db1.Close
db2.Close
Set db1 = Nothing
Set db2 = Nothing

PopulateExistingEquipmentCOA

End Sub


Sub PopulateExistingEquipmentCOA()

Dim i As Integer
Dim db2 As ADODB.Connection

'Create Connection String

Set UsageTracking = New ADODB.Connection
With UsageTracking
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With


Application.EnableEvents = True
'If cboEquipmentCOA.Value <> "" Then
'frmDSRHeader.cboCustomerName.Visible = True

Set adoRecordset = New ADODB.Recordset
adoRecordset.Open _
Source:="SELECT DISTINCT tblDSRSelectProject.COAID, [Code of
Accounts].COA, [Code of Accounts].Description FROM [Code of Accounts]
INNER
JOIN tblDSRSelectProject ON (tblDSRSelectProject.COAID) = ([Code of
Accounts].COAID)", _
ActiveConnection:=db2, _
CursorType:=adOpenStatic, _
LockType:=adLockReadOnly, _
Options:=adCmdText
adoRecordset.MoveFirst

With frmDSRHeader.cboEquipmentCOA
.Clear
.ColumnCount = 3
.BoundColumn = 1
.ColumnWidths = "0;50;216"

Do
.AddItem
.List(i, 0) = adoRecordset![COAID]
.List(i, 1) = adoRecordset![COA]
.List(i, 2) = adoRecordset![Description]
i = i + 1
adoRecordset.MoveNext
Loop Until adoRecordset.EOF
End With

Set adoRecordset = Nothing
UsageTracking.Close
Set UsageTracking = Nothing


End Sub
Click to expand...
 
M

Michelle

Patrick,

Thank you so much for your reply!
I can't get the Click event to work. The screen pops up and when I push
cboBWProjectNumber the combo box opens blank! I have msgboxs strategically
placed so I can tell where the program is going and it's not even hitting the
cboBWProjectNumber_Click event. I thought that was an automatic! You pressed
the button and that's where it went. Am I missing something?

Patrick Molloy said:
for this demo, i have three listboxes. basically they have much of the same
functionality of the combobox except you can see all the items

the idea is that listbox1 clears boxes 2 and 3, while listbox2 causes box 3
to clear. the data shows how the value cascade through.
listbox1 simply has letters from B thro K
clicking a letter loads listbox2 with ten items 'n'1 thro 10 where n is the
letter selected and listbox3 remains empty.
similarly, listbox3 is populated when an item in listbox2 is selected.

I didn't put code in listbox3, but this is where your final filter would
retrieve your report from the database


Option Explicit
Dim i As Long

Private Sub ListBox1_Click()
ListBox2.Clear
ListBox3.Clear
For i = 1 To 10
ListBox2.AddItem ListBox1.Value & i
Next
End Sub

Private Sub ListBox2_Click()
ListBox3.Clear
For i = 1 To 10
ListBox3.AddItem ListBox2.Value & ":" & i
Next

End Sub

Private Sub ListBox3_Click()
'nothing
End Sub

Private Sub UserForm_Initialize()
For i = 1 To 10
ListBox1.AddItem Chr(65 + i)
Next
End Sub



Michelle said:
Hi,
I have a form in excel that contains 4 combo boxes that the user can fill
in
to drill down to pull up an existing record in a table. As the user
selects
from the combo box it narrows his selection criteria from his selections.
For
Example; the first field is Project Number. I fill the combo box with all
projects. The user selects project number 1. Then I write all the project
1's
into a temptable in Access. The second field is EquipCOA. I now want to go
to
the temp table in Access and from the project 1 records I want to pull all
the EquipCoa's for project 1 to put in the combo box. Then the user can
select what EquipCOA they want. then the next combo box is VendID. I fill
the
combo box with selection criteria from the temptable that is filtered by
project 1 and the EquipCoa that was selected.
The problem is I can't get the timing on my code right to fill up the
combo
box for the second EquipCOA selection. Can you help me? Below is my code.

Sub PopulateExistingBWProjectNumber()

Dim i As Integer
Range("BWProjectNumber").Select

'Create Connection String

Set UsageTracking = New ADODB.Connection
With UsageTracking
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With


Application.EnableEvents = True
'If cboEquipmentCOA.Value <> "" Then
'frmDSRHeader.cboCustomerName.Visible = True



Set adoRecordset = New ADODB.Recordset
adoRecordset.Open _
Source:="SELECT DISTINCT tblDSREquipment.BWProjectNumberID,
tblProjectData.BWProjectNumber, tblProjectData.BWProjectName FROM
tblProjectData INNER JOIN tblDSREquipment ON
(tblDSREquipment.BWProjectNumberID) = (tblProjectData.BWProjectNumberID)",
_
ActiveConnection:=UsageTracking, _
CursorType:=adOpenStatic, _
LockType:=adLockReadOnly, _
Options:=adCmdText
adoRecordset.MoveFirst


With frmDSRHeader.cboBWProjectNumber
.Clear
.ColumnCount = 3
.BoundColumn = 1
.ColumnWidths = "0;72;216"

Do
.AddItem
.List(i, 0) = adoRecordset![BWProjectNumberID]
.List(i, 1) = adoRecordset![BWProjectNumber]
.List(i, 2) = adoRecordset![BWProjectName]
i = i + 1
adoRecordset.MoveNext
Loop Until adoRecordset.EOF
End With

frmDSRHeader.cboEquipmentCOA.Enabled = True
Application.EnableEvents = True
'Load frmDSRHeader
frmDSRHeader.Show

WriteProjectRecords 'modExistingDSRValues


Set adoRecordset = Nothing
UsageTracking.Close
Set UsageTracking = Nothing

End Sub

Sub WriteProjectRecords()

Dim db1 As ADODB.Connection
Dim db2 As ADODB.Connection
Dim adoRecordset As ADODB.Recordset
Dim RecordsetTemp As ADODB.Recordset
Dim strSQL As String

'select records from tblDSREquipment and write to database.

'First connection to collect records
Set db1 = New ADODB.Connection
With db1
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With

Application.EnableEvents = False
'cboBWProjectNumber.SetFocus
'If cboEquipmentCOA.Value <> "" Then
'frmDSRHeader.cboCustomerName.Visible = True

Debug.Print intDSRProjectNumber

strSQL = "SELECT tblDSREquipment.DSREquipmentID,
tblDSREquipment.BWProjectNumberID, tblDSREquipment.VendID,
tblDSREquipment.COAID, tblDSREquipment.EquipmentShipDate,
tblDSREquipment.POReleaseDate, tblDSREquipment.DSRCreateDate,
tblDSREquipment.DSRDocumentNumber, tblDSREquipment.DSRDocumentRevision,
tblDSREquipment.SystemPartPolicy, tblDSREquipment.ReleaseIndicator,
tblDSREquipment.EText, tblDSREquipment.LifecycleState,
tblDSREquipment.UOM,
tblDSREquipment.PartBLSCreated, tblProjectData.BWProjectNumber,
tblProjectData.BWProjectName " & _
"FROM tblProjectData INNER JOIN tblDSREquipment ON
tblProjectData.BWProjectNumberID=tblDSREquipment.BWProjectNumberID " & _
"WHERE (((tblDSREquipment.BWProjectNumberID)=1)) " & _
"ORDER BY tblDSREquipment.DSREquipmentID,
tblDSREquipment.BWProjectNumberID ;"

Set adoRecordset = New ADODB.Recordset
adoRecordset.CursorType = adOpenStatic
adoRecordset.LockType = adLockReadOnly
adoRecordset.Open strSQL, db1, adOpenKeyset

Debug.Print strSQL


'WhereStr = "WHERE (((tblDSREquipment.BWProjectNumberID)= ' &
intDSRProjectNumber & '))"

'Write to UsageTracking/tblDSRSelectProject
'Second connection to write records
Set db2 = New ADODB.Connection
With db2
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With

Set RecordsetTemp = New ADODB.Recordset
RecordsetTemp.CursorType = adOpenDynamic
RecordsetTemp.LockType = adLockPessimistic
RecordsetTemp.Open "Select * from tblDSRSelectProject", db2,
adOpenKeyset

With RecordsetTemp
Do
RecordsetTemp.AddNew
.Fields(1) = adoRecordset(1) 'BWProjectNumberID
.Fields(2) = adoRecordset(2) 'VendID
.Fields(3) = adoRecordset(3) 'COAID
.Fields(4) = adoRecordset(4) 'EquipmentShipDate
.Fields(5) = adoRecordset(5) 'POReleaseDate
.Fields(6) = adoRecordset(6) 'DSRCreateDate
.Fields(7) = adoRecordset(7) 'DSRDocumentNumber
.Fields(8) = adoRecordset(8) 'DSRDocumentRevision
.Fields(9) = adoRecordset(9) 'SystemPartPolicy
.Fields(10) = adoRecordset(10) 'ReleaseIndicator
.Fields(11) = adoRecordset(11) 'EText
.Fields(12) = adoRecordset(12) 'LifecycleState
.Fields(13) = adoRecordset(13) 'UOM
.Fields(14) = adoRecordset(14) 'PartBLSCreated
.Fields(15) = adoRecordset(15) 'BWProjectNumber
.Fields(16) = adoRecordset(16) 'BWProjectName

RecordsetTemp.Update
adoRecordset.MoveNext
Loop Until adoRecordset.EOF
End With

Set RecordsetTemp = Nothing
Set adoRecordset = Nothing
db1.Close
db2.Close
Set db1 = Nothing
Set db2 = Nothing

PopulateExistingEquipmentCOA

End Sub


Sub PopulateExistingEquipmentCOA()

Dim i As Integer
Dim db2 As ADODB.Connection

'Create Connection String

Set UsageTracking = New ADODB.Connection
With UsageTracking
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With


Application.EnableEvents = True
'If cboEquipmentCOA.Value <> "" Then
'frmDSRHeader.cboCustomerName.Visible = True

Set adoRecordset = New ADODB.Recordset
adoRecordset.Open _
Source:="SELECT DISTINCT tblDSRSelectProject.COAID, [Code of
Accounts].COA, [Code of Accounts].Description FROM [Code of Accounts]
INNER
JOIN tblDSRSelectProject ON (tblDSRSelectProject.COAID) = ([Code of
Accounts].COAID)", _
ActiveConnection:=db2, _
CursorType:=adOpenStatic, _
LockType:=adLockReadOnly, _
Options:=adCmdText
adoRecordset.MoveFirst

With frmDSRHeader.cboEquipmentCOA
.Clear
.ColumnCount = 3
.BoundColumn = 1
.ColumnWidths = "0;50;216"

Do
.AddItem
.List(i, 0) = adoRecordset![COAID]
.List(i, 1) = adoRecordset![COA]
.List(i, 2) = adoRecordset![Description]
i = i + 1
adoRecordset.MoveNext
Loop Until adoRecordset.EOF
End With

Set adoRecordset = Nothing
UsageTracking.Close
Click to expand...
Click to expand...
 
P

Patrick Molloy

I created a new form with three combo boxes, replaced 'list' with 'combo'
and the code worked fine
There are no buttons


Michelle said:
Patrick,

Thank you so much for your reply!
I can't get the Click event to work. The screen pops up and when I push
cboBWProjectNumber the combo box opens blank! I have msgboxs strategically
placed so I can tell where the program is going and it's not even hitting
the
cboBWProjectNumber_Click event. I thought that was an automatic! You
pressed
the button and that's where it went. Am I missing something?

Patrick Molloy said:
for this demo, i have three listboxes. basically they have much of the
same
functionality of the combobox except you can see all the items

the idea is that listbox1 clears boxes 2 and 3, while listbox2 causes box
3
to clear. the data shows how the value cascade through.
listbox1 simply has letters from B thro K
clicking a letter loads listbox2 with ten items 'n'1 thro 10 where n is
the
letter selected and listbox3 remains empty.
similarly, listbox3 is populated when an item in listbox2 is selected.

I didn't put code in listbox3, but this is where your final filter would
retrieve your report from the database


Option Explicit
Dim i As Long

Private Sub ListBox1_Click()
ListBox2.Clear
ListBox3.Clear
For i = 1 To 10
ListBox2.AddItem ListBox1.Value & i
Next
End Sub

Private Sub ListBox2_Click()
ListBox3.Clear
For i = 1 To 10
ListBox3.AddItem ListBox2.Value & ":" & i
Next

End Sub

Private Sub ListBox3_Click()
'nothing
End Sub

Private Sub UserForm_Initialize()
For i = 1 To 10
ListBox1.AddItem Chr(65 + i)
Next
End Sub



Michelle said:
Hi,
I have a form in excel that contains 4 combo boxes that the user can
fill
in
to drill down to pull up an existing record in a table. As the user
selects
from the combo box it narrows his selection criteria from his
selections.
For
Example; the first field is Project Number. I fill the combo box with
all
projects. The user selects project number 1. Then I write all the
project
1's
into a temptable in Access. The second field is EquipCOA. I now want to
go
to
the temp table in Access and from the project 1 records I want to pull
all
the EquipCoa's for project 1 to put in the combo box. Then the user can
select what EquipCOA they want. then the next combo box is VendID. I
fill
the
combo box with selection criteria from the temptable that is filtered
by
project 1 and the EquipCoa that was selected.
The problem is I can't get the timing on my code right to fill up the
combo
box for the second EquipCOA selection. Can you help me? Below is my
code.

Sub PopulateExistingBWProjectNumber()

Dim i As Integer
Range("BWProjectNumber").Select

'Create Connection String

Set UsageTracking = New ADODB.Connection
With UsageTracking
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With


Application.EnableEvents = True
'If cboEquipmentCOA.Value <> "" Then
'frmDSRHeader.cboCustomerName.Visible = True



Set adoRecordset = New ADODB.Recordset
adoRecordset.Open _
Source:="SELECT DISTINCT tblDSREquipment.BWProjectNumberID,
tblProjectData.BWProjectNumber, tblProjectData.BWProjectName FROM
tblProjectData INNER JOIN tblDSREquipment ON
(tblDSREquipment.BWProjectNumberID) =
(tblProjectData.BWProjectNumberID)",
_
ActiveConnection:=UsageTracking, _
CursorType:=adOpenStatic, _
LockType:=adLockReadOnly, _
Options:=adCmdText
adoRecordset.MoveFirst


With frmDSRHeader.cboBWProjectNumber
.Clear
.ColumnCount = 3
.BoundColumn = 1
.ColumnWidths = "0;72;216"

Do
.AddItem
.List(i, 0) = adoRecordset![BWProjectNumberID]
.List(i, 1) = adoRecordset![BWProjectNumber]
.List(i, 2) = adoRecordset![BWProjectName]
i = i + 1
adoRecordset.MoveNext
Loop Until adoRecordset.EOF
End With

frmDSRHeader.cboEquipmentCOA.Enabled = True
Application.EnableEvents = True
'Load frmDSRHeader
frmDSRHeader.Show

WriteProjectRecords 'modExistingDSRValues


Set adoRecordset = Nothing
UsageTracking.Close
Set UsageTracking = Nothing

End Sub

Sub WriteProjectRecords()

Dim db1 As ADODB.Connection
Dim db2 As ADODB.Connection
Dim adoRecordset As ADODB.Recordset
Dim RecordsetTemp As ADODB.Recordset
Dim strSQL As String

'select records from tblDSREquipment and write to database.

'First connection to collect records
Set db1 = New ADODB.Connection
With db1
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With

Application.EnableEvents = False
'cboBWProjectNumber.SetFocus
'If cboEquipmentCOA.Value <> "" Then
'frmDSRHeader.cboCustomerName.Visible = True

Debug.Print intDSRProjectNumber

strSQL = "SELECT tblDSREquipment.DSREquipmentID,
tblDSREquipment.BWProjectNumberID, tblDSREquipment.VendID,
tblDSREquipment.COAID, tblDSREquipment.EquipmentShipDate,
tblDSREquipment.POReleaseDate, tblDSREquipment.DSRCreateDate,
tblDSREquipment.DSRDocumentNumber, tblDSREquipment.DSRDocumentRevision,
tblDSREquipment.SystemPartPolicy, tblDSREquipment.ReleaseIndicator,
tblDSREquipment.EText, tblDSREquipment.LifecycleState,
tblDSREquipment.UOM,
tblDSREquipment.PartBLSCreated, tblProjectData.BWProjectNumber,
tblProjectData.BWProjectName " & _
"FROM tblProjectData INNER JOIN tblDSREquipment ON
tblProjectData.BWProjectNumberID=tblDSREquipment.BWProjectNumberID " &
_
"WHERE (((tblDSREquipment.BWProjectNumberID)=1)) " & _
"ORDER BY tblDSREquipment.DSREquipmentID,
tblDSREquipment.BWProjectNumberID ;"

Set adoRecordset = New ADODB.Recordset
adoRecordset.CursorType = adOpenStatic
adoRecordset.LockType = adLockReadOnly
adoRecordset.Open strSQL, db1, adOpenKeyset

Debug.Print strSQL


'WhereStr = "WHERE (((tblDSREquipment.BWProjectNumberID)= ' &
intDSRProjectNumber & '))"

'Write to UsageTracking/tblDSRSelectProject
'Second connection to write records
Set db2 = New ADODB.Connection
With db2
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With

Set RecordsetTemp = New ADODB.Recordset
RecordsetTemp.CursorType = adOpenDynamic
RecordsetTemp.LockType = adLockPessimistic
RecordsetTemp.Open "Select * from tblDSRSelectProject", db2,
adOpenKeyset

With RecordsetTemp
Do
RecordsetTemp.AddNew
.Fields(1) = adoRecordset(1) 'BWProjectNumberID
.Fields(2) = adoRecordset(2) 'VendID
.Fields(3) = adoRecordset(3) 'COAID
.Fields(4) = adoRecordset(4) 'EquipmentShipDate
.Fields(5) = adoRecordset(5) 'POReleaseDate
.Fields(6) = adoRecordset(6) 'DSRCreateDate
.Fields(7) = adoRecordset(7) 'DSRDocumentNumber
.Fields(8) = adoRecordset(8) 'DSRDocumentRevision
.Fields(9) = adoRecordset(9) 'SystemPartPolicy
.Fields(10) = adoRecordset(10) 'ReleaseIndicator
.Fields(11) = adoRecordset(11) 'EText
.Fields(12) = adoRecordset(12) 'LifecycleState
.Fields(13) = adoRecordset(13) 'UOM
.Fields(14) = adoRecordset(14) 'PartBLSCreated
.Fields(15) = adoRecordset(15) 'BWProjectNumber
.Fields(16) = adoRecordset(16) 'BWProjectName

RecordsetTemp.Update
adoRecordset.MoveNext
Loop Until adoRecordset.EOF
End With

Set RecordsetTemp = Nothing
Set adoRecordset = Nothing
db1.Close
db2.Close
Set db1 = Nothing
Set db2 = Nothing

PopulateExistingEquipmentCOA

End Sub


Sub PopulateExistingEquipmentCOA()

Dim i As Integer
Dim db2 As ADODB.Connection

'Create Connection String

Set UsageTracking = New ADODB.Connection
With UsageTracking
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With


Application.EnableEvents = True
'If cboEquipmentCOA.Value <> "" Then
'frmDSRHeader.cboCustomerName.Visible = True

Set adoRecordset = New ADODB.Recordset
adoRecordset.Open _
Source:="SELECT DISTINCT tblDSRSelectProject.COAID, [Code of
Accounts].COA, [Code of Accounts].Description FROM [Code of Accounts]
INNER
JOIN tblDSRSelectProject ON (tblDSRSelectProject.COAID) = ([Code of
Accounts].COAID)", _
ActiveConnection:=db2, _
CursorType:=adOpenStatic, _
LockType:=adLockReadOnly, _
Options:=adCmdText
adoRecordset.MoveFirst

With frmDSRHeader.cboEquipmentCOA
.Clear
.ColumnCount = 3
.BoundColumn = 1
.ColumnWidths = "0;50;216"

Do
.AddItem
.List(i, 0) = adoRecordset![COAID]
.List(i, 1) = adoRecordset![COA]
.List(i, 2) = adoRecordset![Description]
i = i + 1
adoRecordset.MoveNext
Loop Until adoRecordset.EOF
End With

Set adoRecordset = Nothing
UsageTracking.Close
Click to expand...
Click to expand...
Click to expand...
 
M

Michelle

When I said button I meant the down arrow button on the combobox. The Click
event does not work on the combo box. It just never goes there. I even
recreated the combo box and it created the Change event in VBA. We are
running 2007. I don't know what's going on with it.


Patrick Molloy said:
I created a new form with three combo boxes, replaced 'list' with 'combo'
and the code worked fine
There are no buttons


Michelle said:
Patrick,

Thank you so much for your reply!
I can't get the Click event to work. The screen pops up and when I push
cboBWProjectNumber the combo box opens blank! I have msgboxs strategically
placed so I can tell where the program is going and it's not even hitting
the
cboBWProjectNumber_Click event. I thought that was an automatic! You
pressed
the button and that's where it went. Am I missing something?

Patrick Molloy said:
for this demo, i have three listboxes. basically they have much of the
same
functionality of the combobox except you can see all the items

the idea is that listbox1 clears boxes 2 and 3, while listbox2 causes box
3
to clear. the data shows how the value cascade through.
listbox1 simply has letters from B thro K
clicking a letter loads listbox2 with ten items 'n'1 thro 10 where n is
the
letter selected and listbox3 remains empty.
similarly, listbox3 is populated when an item in listbox2 is selected.

I didn't put code in listbox3, but this is where your final filter would
retrieve your report from the database


Option Explicit
Dim i As Long

Private Sub ListBox1_Click()
ListBox2.Clear
ListBox3.Clear
For i = 1 To 10
ListBox2.AddItem ListBox1.Value & i
Next
End Sub

Private Sub ListBox2_Click()
ListBox3.Clear
For i = 1 To 10
ListBox3.AddItem ListBox2.Value & ":" & i
Next

End Sub

Private Sub ListBox3_Click()
'nothing
End Sub

Private Sub UserForm_Initialize()
For i = 1 To 10
ListBox1.AddItem Chr(65 + i)
Next
End Sub



Hi,
I have a form in excel that contains 4 combo boxes that the user can
fill
in
to drill down to pull up an existing record in a table. As the user
selects
from the combo box it narrows his selection criteria from his
selections.
For
Example; the first field is Project Number. I fill the combo box with
all
projects. The user selects project number 1. Then I write all the
project
1's
into a temptable in Access. The second field is EquipCOA. I now want to
go
to
the temp table in Access and from the project 1 records I want to pull
all
the EquipCoa's for project 1 to put in the combo box. Then the user can
select what EquipCOA they want. then the next combo box is VendID. I
fill
the
combo box with selection criteria from the temptable that is filtered
by
project 1 and the EquipCoa that was selected.
The problem is I can't get the timing on my code right to fill up the
combo
box for the second EquipCOA selection. Can you help me? Below is my
code.

Sub PopulateExistingBWProjectNumber()

Dim i As Integer
Range("BWProjectNumber").Select

'Create Connection String

Set UsageTracking = New ADODB.Connection
With UsageTracking
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With


Application.EnableEvents = True
'If cboEquipmentCOA.Value <> "" Then
'frmDSRHeader.cboCustomerName.Visible = True



Set adoRecordset = New ADODB.Recordset
adoRecordset.Open _
Source:="SELECT DISTINCT tblDSREquipment.BWProjectNumberID,
tblProjectData.BWProjectNumber, tblProjectData.BWProjectName FROM
tblProjectData INNER JOIN tblDSREquipment ON
(tblDSREquipment.BWProjectNumberID) =
(tblProjectData.BWProjectNumberID)",
_
ActiveConnection:=UsageTracking, _
CursorType:=adOpenStatic, _
LockType:=adLockReadOnly, _
Options:=adCmdText
adoRecordset.MoveFirst


With frmDSRHeader.cboBWProjectNumber
.Clear
.ColumnCount = 3
.BoundColumn = 1
.ColumnWidths = "0;72;216"

Do
.AddItem
.List(i, 0) = adoRecordset![BWProjectNumberID]
.List(i, 1) = adoRecordset![BWProjectNumber]
.List(i, 2) = adoRecordset![BWProjectName]
i = i + 1
adoRecordset.MoveNext
Loop Until adoRecordset.EOF
End With

frmDSRHeader.cboEquipmentCOA.Enabled = True
Application.EnableEvents = True
'Load frmDSRHeader
frmDSRHeader.Show

WriteProjectRecords 'modExistingDSRValues


Set adoRecordset = Nothing
UsageTracking.Close
Set UsageTracking = Nothing

End Sub

Sub WriteProjectRecords()

Dim db1 As ADODB.Connection
Dim db2 As ADODB.Connection
Dim adoRecordset As ADODB.Recordset
Dim RecordsetTemp As ADODB.Recordset
Dim strSQL As String

'select records from tblDSREquipment and write to database.

'First connection to collect records
Set db1 = New ADODB.Connection
With db1
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With

Application.EnableEvents = False
'cboBWProjectNumber.SetFocus
'If cboEquipmentCOA.Value <> "" Then
'frmDSRHeader.cboCustomerName.Visible = True

Debug.Print intDSRProjectNumber

strSQL = "SELECT tblDSREquipment.DSREquipmentID,
tblDSREquipment.BWProjectNumberID, tblDSREquipment.VendID,
tblDSREquipment.COAID, tblDSREquipment.EquipmentShipDate,
tblDSREquipment.POReleaseDate, tblDSREquipment.DSRCreateDate,
tblDSREquipment.DSRDocumentNumber, tblDSREquipment.DSRDocumentRevision,
tblDSREquipment.SystemPartPolicy, tblDSREquipment.ReleaseIndicator,
tblDSREquipment.EText, tblDSREquipment.LifecycleState,
tblDSREquipment.UOM,
tblDSREquipment.PartBLSCreated, tblProjectData.BWProjectNumber,
tblProjectData.BWProjectName " & _
"FROM tblProjectData INNER JOIN tblDSREquipment ON
tblProjectData.BWProjectNumberID=tblDSREquipment.BWProjectNumberID " &
_
"WHERE (((tblDSREquipment.BWProjectNumberID)=1)) " & _
"ORDER BY tblDSREquipment.DSREquipmentID,
tblDSREquipment.BWProjectNumberID ;"

Set adoRecordset = New ADODB.Recordset
adoRecordset.CursorType = adOpenStatic
adoRecordset.LockType = adLockReadOnly
adoRecordset.Open strSQL, db1, adOpenKeyset

Debug.Print strSQL


'WhereStr = "WHERE (((tblDSREquipment.BWProjectNumberID)= ' &
intDSRProjectNumber & '))"

'Write to UsageTracking/tblDSRSelectProject
'Second connection to write records
Set db2 = New ADODB.Connection
With db2
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With

Set RecordsetTemp = New ADODB.Recordset
RecordsetTemp.CursorType = adOpenDynamic
RecordsetTemp.LockType = adLockPessimistic
RecordsetTemp.Open "Select * from tblDSRSelectProject", db2,
adOpenKeyset

With RecordsetTemp
Do
RecordsetTemp.AddNew
.Fields(1) = adoRecordset(1) 'BWProjectNumberID
.Fields(2) = adoRecordset(2) 'VendID
.Fields(3) = adoRecordset(3) 'COAID
.Fields(4) = adoRecordset(4) 'EquipmentShipDate
.Fields(5) = adoRecordset(5) 'POReleaseDate
.Fields(6) = adoRecordset(6) 'DSRCreateDate
.Fields(7) = adoRecordset(7) 'DSRDocumentNumber
.Fields(8) = adoRecordset(8) 'DSRDocumentRevision
.Fields(9) = adoRecordset(9) 'SystemPartPolicy
.Fields(10) = adoRecordset(10) 'ReleaseIndicator
.Fields(11) = adoRecordset(11) 'EText
.Fields(12) = adoRecordset(12) 'LifecycleState
.Fields(13) = adoRecordset(13) 'UOM
.Fields(14) = adoRecordset(14) 'PartBLSCreated
.Fields(15) = adoRecordset(15) 'BWProjectNumber
.Fields(16) = adoRecordset(16) 'BWProjectName

RecordsetTemp.Update
adoRecordset.MoveNext
Loop Until adoRecordset.EOF
End With

Set RecordsetTemp = Nothing
Set adoRecordset = Nothing
db1.Close
db2.Close
Set db1 = Nothing
Set db2 = Nothing

PopulateExistingEquipmentCOA

End Sub


Sub PopulateExistingEquipmentCOA()

Dim i As Integer
Dim db2 As ADODB.Connection

'Create Connection String

Set UsageTracking = New ADODB.Connection
With UsageTracking
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With


Application.EnableEvents = True
Click to expand...
Click to expand...
Click to expand...
 
P

Patrick Molloy

the click event of a combobox isn't fired when the arrow is clicked - all
that does is show th elist of items. The click event fires when an item is
clicked

Michelle said:
When I said button I meant the down arrow button on the combobox. The
Click
event does not work on the combo box. It just never goes there. I even
recreated the combo box and it created the Change event in VBA. We are
running 2007. I don't know what's going on with it.


Patrick Molloy said:
I created a new form with three combo boxes, replaced 'list' with 'combo'
and the code worked fine
There are no buttons


Michelle said:
Patrick,

Thank you so much for your reply!
I can't get the Click event to work. The screen pops up and when I push
cboBWProjectNumber the combo box opens blank! I have msgboxs
strategically
placed so I can tell where the program is going and it's not even
hitting
the
cboBWProjectNumber_Click event. I thought that was an automatic! You
pressed
the button and that's where it went. Am I missing something?

:

for this demo, i have three listboxes. basically they have much of the
same
functionality of the combobox except you can see all the items

the idea is that listbox1 clears boxes 2 and 3, while listbox2 causes
box
3
to clear. the data shows how the value cascade through.
listbox1 simply has letters from B thro K
clicking a letter loads listbox2 with ten items 'n'1 thro 10 where n
is
the
letter selected and listbox3 remains empty.
similarly, listbox3 is populated when an item in listbox2 is selected.

I didn't put code in listbox3, but this is where your final filter
would
retrieve your report from the database


Option Explicit
Dim i As Long

Private Sub ListBox1_Click()
ListBox2.Clear
ListBox3.Clear
For i = 1 To 10
ListBox2.AddItem ListBox1.Value & i
Next
End Sub

Private Sub ListBox2_Click()
ListBox3.Clear
For i = 1 To 10
ListBox3.AddItem ListBox2.Value & ":" & i
Next

End Sub

Private Sub ListBox3_Click()
'nothing
End Sub

Private Sub UserForm_Initialize()
For i = 1 To 10
ListBox1.AddItem Chr(65 + i)
Next
End Sub



Hi,
I have a form in excel that contains 4 combo boxes that the user can
fill
in
to drill down to pull up an existing record in a table. As the user
selects
from the combo box it narrows his selection criteria from his
selections.
For
Example; the first field is Project Number. I fill the combo box
with
all
projects. The user selects project number 1. Then I write all the
project
1's
into a temptable in Access. The second field is EquipCOA. I now want
to
go
to
the temp table in Access and from the project 1 records I want to
pull
all
the EquipCoa's for project 1 to put in the combo box. Then the user
can
select what EquipCOA they want. then the next combo box is VendID. I
fill
the
combo box with selection criteria from the temptable that is
filtered
by
project 1 and the EquipCoa that was selected.
The problem is I can't get the timing on my code right to fill up
the
combo
box for the second EquipCOA selection. Can you help me? Below is my
code.

Sub PopulateExistingBWProjectNumber()

Dim i As Integer
Range("BWProjectNumber").Select

'Create Connection String

Set UsageTracking = New ADODB.Connection
With UsageTracking
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With


Application.EnableEvents = True
'If cboEquipmentCOA.Value <> "" Then
'frmDSRHeader.cboCustomerName.Visible = True



Set adoRecordset = New ADODB.Recordset
adoRecordset.Open _
Source:="SELECT DISTINCT tblDSREquipment.BWProjectNumberID,
tblProjectData.BWProjectNumber, tblProjectData.BWProjectName FROM
tblProjectData INNER JOIN tblDSREquipment ON
(tblDSREquipment.BWProjectNumberID) =
(tblProjectData.BWProjectNumberID)",
_
ActiveConnection:=UsageTracking, _
CursorType:=adOpenStatic, _
LockType:=adLockReadOnly, _
Options:=adCmdText
adoRecordset.MoveFirst


With frmDSRHeader.cboBWProjectNumber
.Clear
.ColumnCount = 3
.BoundColumn = 1
.ColumnWidths = "0;72;216"

Do
.AddItem
.List(i, 0) = adoRecordset![BWProjectNumberID]
.List(i, 1) = adoRecordset![BWProjectNumber]
.List(i, 2) = adoRecordset![BWProjectName]
i = i + 1
adoRecordset.MoveNext
Loop Until adoRecordset.EOF
End With

frmDSRHeader.cboEquipmentCOA.Enabled = True
Application.EnableEvents = True
'Load frmDSRHeader
frmDSRHeader.Show

WriteProjectRecords 'modExistingDSRValues


Set adoRecordset = Nothing
UsageTracking.Close
Set UsageTracking = Nothing

End Sub

Sub WriteProjectRecords()

Dim db1 As ADODB.Connection
Dim db2 As ADODB.Connection
Dim adoRecordset As ADODB.Recordset
Dim RecordsetTemp As ADODB.Recordset
Dim strSQL As String

'select records from tblDSREquipment and write to database.

'First connection to collect records
Set db1 = New ADODB.Connection
With db1
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With

Application.EnableEvents = False
'cboBWProjectNumber.SetFocus
'If cboEquipmentCOA.Value <> "" Then
'frmDSRHeader.cboCustomerName.Visible = True

Debug.Print intDSRProjectNumber

strSQL = "SELECT tblDSREquipment.DSREquipmentID,
tblDSREquipment.BWProjectNumberID, tblDSREquipment.VendID,
tblDSREquipment.COAID, tblDSREquipment.EquipmentShipDate,
tblDSREquipment.POReleaseDate, tblDSREquipment.DSRCreateDate,
tblDSREquipment.DSRDocumentNumber,
tblDSREquipment.DSRDocumentRevision,
tblDSREquipment.SystemPartPolicy, tblDSREquipment.ReleaseIndicator,
tblDSREquipment.EText, tblDSREquipment.LifecycleState,
tblDSREquipment.UOM,
tblDSREquipment.PartBLSCreated, tblProjectData.BWProjectNumber,
tblProjectData.BWProjectName " & _
"FROM tblProjectData INNER JOIN tblDSREquipment ON
tblProjectData.BWProjectNumberID=tblDSREquipment.BWProjectNumberID "
&
_
"WHERE (((tblDSREquipment.BWProjectNumberID)=1)) " & _
"ORDER BY tblDSREquipment.DSREquipmentID,
tblDSREquipment.BWProjectNumberID ;"

Set adoRecordset = New ADODB.Recordset
adoRecordset.CursorType = adOpenStatic
adoRecordset.LockType = adLockReadOnly
adoRecordset.Open strSQL, db1, adOpenKeyset

Debug.Print strSQL


'WhereStr = "WHERE (((tblDSREquipment.BWProjectNumberID)= ' &
intDSRProjectNumber & '))"

'Write to UsageTracking/tblDSRSelectProject
'Second connection to write records
Set db2 = New ADODB.Connection
With db2
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With

Set RecordsetTemp = New ADODB.Recordset
RecordsetTemp.CursorType = adOpenDynamic
RecordsetTemp.LockType = adLockPessimistic
RecordsetTemp.Open "Select * from tblDSRSelectProject", db2,
adOpenKeyset

With RecordsetTemp
Do
RecordsetTemp.AddNew
.Fields(1) = adoRecordset(1) 'BWProjectNumberID
.Fields(2) = adoRecordset(2) 'VendID
.Fields(3) = adoRecordset(3) 'COAID
.Fields(4) = adoRecordset(4) 'EquipmentShipDate
.Fields(5) = adoRecordset(5) 'POReleaseDate
.Fields(6) = adoRecordset(6) 'DSRCreateDate
.Fields(7) = adoRecordset(7) 'DSRDocumentNumber
.Fields(8) = adoRecordset(8) 'DSRDocumentRevision
.Fields(9) = adoRecordset(9) 'SystemPartPolicy
.Fields(10) = adoRecordset(10) 'ReleaseIndicator
.Fields(11) = adoRecordset(11) 'EText
.Fields(12) = adoRecordset(12) 'LifecycleState
.Fields(13) = adoRecordset(13) 'UOM
.Fields(14) = adoRecordset(14) 'PartBLSCreated
.Fields(15) = adoRecordset(15) 'BWProjectNumber
.Fields(16) = adoRecordset(16) 'BWProjectName

RecordsetTemp.Update
adoRecordset.MoveNext
Loop Until adoRecordset.EOF
End With

Set RecordsetTemp = Nothing
Set adoRecordset = Nothing
db1.Close
db2.Close
Set db1 = Nothing
Set db2 = Nothing

PopulateExistingEquipmentCOA

End Sub


Sub PopulateExistingEquipmentCOA()

Dim i As Integer
Dim db2 As ADODB.Connection

'Create Connection String

Set UsageTracking = New ADODB.Connection
With UsageTracking
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With


Application.EnableEvents = True
Click to expand...
Click to expand...
Click to expand...
 
M

Michelle

Thanks Pat!

No wonder I couldn't get the thing to work! I'm trying to fill the 2nd
combobox with selections BEFORE the user can select from this box. The click
event won't work.




Patrick Molloy said:
the click event of a combobox isn't fired when the arrow is clicked - all
that does is show th elist of items. The click event fires when an item is
clicked

Michelle said:
When I said button I meant the down arrow button on the combobox. The
Click
event does not work on the combo box. It just never goes there. I even
recreated the combo box and it created the Change event in VBA. We are
running 2007. I don't know what's going on with it.


Patrick Molloy said:
I created a new form with three combo boxes, replaced 'list' with 'combo'
and the code worked fine
There are no buttons


Patrick,

Thank you so much for your reply!
I can't get the Click event to work. The screen pops up and when I push
cboBWProjectNumber the combo box opens blank! I have msgboxs
strategically
placed so I can tell where the program is going and it's not even
hitting
the
cboBWProjectNumber_Click event. I thought that was an automatic! You
pressed
the button and that's where it went. Am I missing something?

:

for this demo, i have three listboxes. basically they have much of the
same
functionality of the combobox except you can see all the items

the idea is that listbox1 clears boxes 2 and 3, while listbox2 causes
box
3
to clear. the data shows how the value cascade through.
listbox1 simply has letters from B thro K
clicking a letter loads listbox2 with ten items 'n'1 thro 10 where n
is
the
letter selected and listbox3 remains empty.
similarly, listbox3 is populated when an item in listbox2 is selected.

I didn't put code in listbox3, but this is where your final filter
would
retrieve your report from the database


Option Explicit
Dim i As Long

Private Sub ListBox1_Click()
ListBox2.Clear
ListBox3.Clear
For i = 1 To 10
ListBox2.AddItem ListBox1.Value & i
Next
End Sub

Private Sub ListBox2_Click()
ListBox3.Clear
For i = 1 To 10
ListBox3.AddItem ListBox2.Value & ":" & i
Next

End Sub

Private Sub ListBox3_Click()
'nothing
End Sub

Private Sub UserForm_Initialize()
For i = 1 To 10
ListBox1.AddItem Chr(65 + i)
Next
End Sub



Hi,
I have a form in excel that contains 4 combo boxes that the user can
fill
in
to drill down to pull up an existing record in a table. As the user
selects
from the combo box it narrows his selection criteria from his
selections.
For
Example; the first field is Project Number. I fill the combo box
with
all
projects. The user selects project number 1. Then I write all the
project
1's
into a temptable in Access. The second field is EquipCOA. I now want
to
go
to
the temp table in Access and from the project 1 records I want to
pull
all
the EquipCoa's for project 1 to put in the combo box. Then the user
can
select what EquipCOA they want. then the next combo box is VendID. I
fill
the
combo box with selection criteria from the temptable that is
filtered
by
project 1 and the EquipCoa that was selected.
The problem is I can't get the timing on my code right to fill up
the
combo
box for the second EquipCOA selection. Can you help me? Below is my
code.

Sub PopulateExistingBWProjectNumber()

Dim i As Integer
Range("BWProjectNumber").Select

'Create Connection String

Set UsageTracking = New ADODB.Connection
With UsageTracking
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With


Application.EnableEvents = True
'If cboEquipmentCOA.Value <> "" Then
'frmDSRHeader.cboCustomerName.Visible = True



Set adoRecordset = New ADODB.Recordset
adoRecordset.Open _
Source:="SELECT DISTINCT tblDSREquipment.BWProjectNumberID,
tblProjectData.BWProjectNumber, tblProjectData.BWProjectName FROM
tblProjectData INNER JOIN tblDSREquipment ON
(tblDSREquipment.BWProjectNumberID) =
(tblProjectData.BWProjectNumberID)",
_
ActiveConnection:=UsageTracking, _
CursorType:=adOpenStatic, _
LockType:=adLockReadOnly, _
Options:=adCmdText
adoRecordset.MoveFirst


With frmDSRHeader.cboBWProjectNumber
.Clear
.ColumnCount = 3
.BoundColumn = 1
.ColumnWidths = "0;72;216"

Do
.AddItem
.List(i, 0) = adoRecordset![BWProjectNumberID]
.List(i, 1) = adoRecordset![BWProjectNumber]
.List(i, 2) = adoRecordset![BWProjectName]
i = i + 1
adoRecordset.MoveNext
Loop Until adoRecordset.EOF
End With

frmDSRHeader.cboEquipmentCOA.Enabled = True
Application.EnableEvents = True
'Load frmDSRHeader
frmDSRHeader.Show

WriteProjectRecords 'modExistingDSRValues


Set adoRecordset = Nothing
UsageTracking.Close
Set UsageTracking = Nothing

End Sub

Sub WriteProjectRecords()

Dim db1 As ADODB.Connection
Dim db2 As ADODB.Connection
Dim adoRecordset As ADODB.Recordset
Dim RecordsetTemp As ADODB.Recordset
Dim strSQL As String

'select records from tblDSREquipment and write to database.

'First connection to collect records
Set db1 = New ADODB.Connection
With db1
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With

Application.EnableEvents = False
'cboBWProjectNumber.SetFocus
'If cboEquipmentCOA.Value <> "" Then
'frmDSRHeader.cboCustomerName.Visible = True

Debug.Print intDSRProjectNumber

strSQL = "SELECT tblDSREquipment.DSREquipmentID,
tblDSREquipment.BWProjectNumberID, tblDSREquipment.VendID,
tblDSREquipment.COAID, tblDSREquipment.EquipmentShipDate,
tblDSREquipment.POReleaseDate, tblDSREquipment.DSRCreateDate,
tblDSREquipment.DSRDocumentNumber,
tblDSREquipment.DSRDocumentRevision,
tblDSREquipment.SystemPartPolicy, tblDSREquipment.ReleaseIndicator,
tblDSREquipment.EText, tblDSREquipment.LifecycleState,
tblDSREquipment.UOM,
tblDSREquipment.PartBLSCreated, tblProjectData.BWProjectNumber,
tblProjectData.BWProjectName " & _
"FROM tblProjectData INNER JOIN tblDSREquipment ON
tblProjectData.BWProjectNumberID=tblDSREquipment.BWProjectNumberID "
&
_
"WHERE (((tblDSREquipment.BWProjectNumberID)=1)) " & _
"ORDER BY tblDSREquipment.DSREquipmentID,
tblDSREquipment.BWProjectNumberID ;"

Set adoRecordset = New ADODB.Recordset
adoRecordset.CursorType = adOpenStatic
adoRecordset.LockType = adLockReadOnly
adoRecordset.Open strSQL, db1, adOpenKeyset

Debug.Print strSQL


'WhereStr = "WHERE (((tblDSREquipment.BWProjectNumberID)= ' &
intDSRProjectNumber & '))"

'Write to UsageTracking/tblDSRSelectProject
'Second connection to write records
Set db2 = New ADODB.Connection
With db2
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" &
"\\bsrvfp04\shared\PLM\database\UsageTracking.mdb" & "; "
.Mode = adModeShareDenyNone
.Open
End With

Set RecordsetTemp = New ADODB.Recordset
RecordsetTemp.CursorType = adOpenDynamic
RecordsetTemp.LockType = adLockPessimistic
RecordsetTemp.Open "Select * from tblDSRSelectProject", db2,
adOpenKeyset

With RecordsetTemp
Do
RecordsetTemp.AddNew
.Fields(1) = adoRecordset(1) 'BWProjectNumberID
.Fields(2) = adoRecordset(2) 'VendID
.Fields(3) = adoRecordset(3) 'COAID
.Fields(4) = adoRecordset(4) 'EquipmentShipDate
.Fields(5) = adoRecordset(5) 'POReleaseDate
.Fields(6) = adoRecordset(6) 'DSRCreateDate
.Fields(7) = adoRecordset(7) 'DSRDocumentNumber
.Fields(8) = adoRecordset(8) 'DSRDocumentRevision
.Fields(9) = adoRecordset(9) 'SystemPartPolicy
.Fields(10) = adoRecordset(10) 'ReleaseIndicator
.Fields(11) = adoRecordset(11) 'EText
.Fields(12) = adoRecordset(12) 'LifecycleState
.Fields(13) = adoRecordset(13) 'UOM
.Fields(14) = adoRecordset(14) 'PartBLSCreated
.Fields(15) = adoRecordset(15) 'BWProjectNumber
.Fields(16) = adoRecordset(16) 'BWProjectName

RecordsetTemp.Update
adoRecordset.MoveNext
Loop Until adoRecordset.EOF
End With

Set RecordsetTemp = Nothing
Set adoRecordset = Nothing
db1.Close
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

SQL statement not working 2

Top