Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > waiting for user response
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 310
Default waiting for user response
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.B WProjectNumberID " & _
"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





Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1,049
Default waiting for user response
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" wrote in message
...
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.B WProjectNumberID " & _
"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





Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 310
Default waiting for user response
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" wrote:

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" wrote in message
...
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.B WProjectNumberID " & _
"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
Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1,049
Default waiting for user response
I created a new form with three combo boxes, replaced 'list' with 'combo'
and the code worked fine
There are no buttons


"Michelle" wrote in message
...
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" wrote:

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" wrote in message
...
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.B WProjectNumberID " &
_
"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

Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 310
Default waiting for user response
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" wrote:

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


"Michelle" wrote in message
...
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" wrote:

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" wrote in message
...
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.B WProjectNumberID " &
_
"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
Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1,049
Default waiting for user response
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" wrote in message
...
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" wrote:

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


"Michelle" wrote in message
...
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" wrote:

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" wrote in message
...
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.B WProjectNumberID "
&
_
"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

Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 310
Default waiting for user response
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" wrote:

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" wrote in message
...
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" wrote:

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


"Michelle" wrote in message
...
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" wrote:

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" wrote in message
...
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.B WProjectNumberID "
&
_
"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
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
waiting (or pausing) for user selections - nested loops vs. serialexecution [email protected] Excel Programming 2 August 28th 08 09:23 PM
Giving some feedback to user, when waiting on SQL SELECT query to finish Morris[_2_] Excel Programming 2 September 20th 06 04:08 AM
Storing User response Marco Excel Programming 1 June 2nd 06 11:33 PM
Wait for user response Brisbane Rob[_2_] Excel Programming 1 September 17th 05 10:31 PM
Wait for user response dominicb[_127_] Excel Programming 0 September 16th 05 10:28 PM


All times are GMT +1. The time now is 06:03 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement