Help with applying code
I would like to thank you OssieMac for looking over my code problem, but
after going over it for the millionth time I found an ovewrsite on my part
from when I was first designing the database. I had pointed the rowsource
property of both the CbxMan and CbxProd to another sheet with a row name so
no matter what code I applied it would not have worked, so I have fixed my
problem myself, again thank you for your time.
"Mekinnik" wrote:
Can someone please look over the code I have posted and please tell me why
its that when it is applied to my current project it will not work right. It
is suppose to work like this. When you select a value from combobox1 it
checks to see it it is on sheet1 column'A' and if it is return what ever
value matches that value to combobox2 from sheet2 column'B'. This is what
sheet 2 looks like.
column A column B
a 1
a 2
b 1
c 1
a 3
For ever "a" in column 'a' it is suppose to return the column 'B' value so
(1,2,3). Whuch works just fine in the test version, however when it is
applied to my project code it does not work right it return to combobox2 the
same values as combobox1 which is wrong. Here is the code from both my forms.
**My test from code**
Private Sub Cbo1_Change()
Application.EnableEvents = True
Dim S As String
Dim V As Variant
Dim J As Range
'catches user input and checks to see if it's
S = Me.Cbo1.Text
V = Application.Match(S, Worksheets("sheet1").Range("A1:A10"), 0)
If IsError(V) = True Then
frm1.Hide
frm2.Show
End If
If IsError(V) = False Then
With Me.Cbo2
.Clear
For Each J In Worksheets("test").Range("A1:A18")
If J.Text = S Then
.AddItem J(1, 2)
End If
Next J
.SetFocus
If .ListCount 0 Then
.ListIndex = 0
End If
End With
End If
End Sub
Private Sub UserForm_Initialize()
Cbo1.RowSource = Worksheets("sheet1").Range("A1:A10").Address(exter nal:=True)
End Sub
**My project form code**
Me.CkBox3.Value = False
Me.CboFire.Value = ""
Me.CboHealth.Value = ""
Me.CboReact.Value = ""
Me.CboSpec.Value = ""
Me.CboDisp.Value = ""
Me.TxtQuan.Value = ""
Me.TxtDate.Value = ""
ender:
MsgBox "Value not found"
End Sub
Private Sub CbxMfg_Change()
Dim S As String
Dim V As Variant
Dim J As Range
S = Me.CbxMfg.Text
V = Application.Match(S, Worksheets("MANCODE").Range("A2:A1000"), 0)
If IsError(V) = True Then
FrmProduct.Hide
FrmManu.Show
End If
If IsError(V) = False Then
With Me.CbxProd
' .Clear
For Each J In Worksheets("ProCode").Range("A2:A1000")
If J.Text = S Then
.AddItem J(1, 2)
End If
Next J
.SetFocus
If .ListCount 0 Then
.ListIndex = 0
End If
End With
End If
End Sub
Private Sub TxtDate_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
FrmCalendar.Show
End Sub
Private Sub UserForm_Initialize()
CbxMfg.RowSource =
Worksheets("MANCODE").Range("A2:A1000").Address(ex ternal:=True)
'CboFire.RowSource =
Worksheets("Lists").Range("D2:D5").Address(externa l:=True)
'CboHealth.RowSource =
Worksheets("Lists").Range("D2:D5").Address(externa l:=True)
'CboReact.RowSource =
Worksheets("Lists").Range("D2:D5").Address(externa l:=True)
'CboDisp.RowSource =
Worksheets("Lists").Range("E2:E4").Address(externa l:=True)
'CboDept.RowSource =
Worksheets("Lists").Range("C2:C10").Address(extern al:=True)
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
'Cancel = False
FrmManu.Hide
StrtUpFrm.Show
End If
End Sub
|