Help with code issues

M

Mekinnik

I am using Office 2003. I have a database that stores manufacturer
information on 1 sheet ('MANCODE') and their product information on another
sheet ('ProCode') I have 2 user forms for entering the information. I am
trying to have when the user either enters in or chooses a manufacterers name
in userform ('FrmManu') from combobox ('CbxMfg') and clicks the next button
or the add button the name ('CbxMfg.Value') from combobox ('CbxMfg') gets
transfered to userform ('FrmProduct') combobox('CbxMfg') and searches upon
form initialize sheet ('Procode') columns 1 (manufacturer name) and 2
(product name) for every product that matches the 'CbxMfg' text value and
populates the combobox ('CbxProd') list so the user may choose the product
from the drop down, however if the search produces no products matching the
manufacturer name the a msgbox will show infoming the user to enter the new
product name. The current code I have only links the two comboxes togeter it
does not search for the names and that is what I am looking to do. Here is
the code for both user forms:

User form 'FrmManu'

Private Sub BtnAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Dim res As Variant
Set ws = Worksheets("MANCODE")

'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

'check for the manufacturer name
If Trim(Me.TxtMan.Value) = "" Then
Me.TxtMan.SetFocus
MsgBox "Please enter the Manufacturer's name"
Exit Sub
End If

'find and copy state abbreviation to row 5
With Worksheets("Lists")
res = Application.VLookup(Me.CmbSt.Value, _
Worksheets("Lists").Range("A:B"), 2, False)
If IsError(res) Then
Else
ws.Cells(iRow, 4).Value = (res)
End If
End With

'copy the data to the database
Application.EnableEvents = False
ws.Cells(iRow, 2).Value = Me.TxtAdd.Value
ws.Cells(iRow, 3).Value = Me.TxtCity.Value
ws.Cells(iRow, 5).Value = Me.TxtZip.Value
ws.Cells(iRow, 6).Value = Me.TxtPhn.Value
Application.EnableEvents = True

'the sort will fire with this line.
ws.Cells(iRow, 1).Value = Me.TxtMan.Value
FrmProduct.CboMan.Value = Me.TxtMan.Value


'clear the data
Me.TxtMan.Value = ""
Me.TxtAdd.Value = ""
Me.TxtCity.Value = ""
Me.CmbSt.Value = ""
Me.TxtZip.Value = ""
Me.TxtPhn.Value = ""

'close window and return to product window
FrmManu.Hide
FrmProduct.Show

End Sub

Private Sub BtnDelete_Click()
Dim fRow As Long

On Error GoTo ender
fRow = Columns(1).Find(What:=TxtMan.Value, _
After:=Cells(5000, 1), LookIn:=xlFormulas, _
LookAT:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False).Row
Rows(fRow).Delete
Exit Sub

ender:
MsgBox "Value not found"
End Sub

Private Sub BtnNext_Click()
FrmManu.Hide
FrmProduct.CbxMfg.Value = Me.TxtMan.Value
FrmProduct.Show
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
'Cancel = False
'Else
FrmManu.Hide
StrtUpFrm.Show
End If
End Sub



And userform 'FrmProduct'

Option Explicit
Option Compare Text
Private bEnableEvents As Boolean
Private MfgRange As Range
Private ProdRange As Range

Private Sub BtnAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Dim intMtoprow As Integer
Dim dept As String
Dim x As Integer
Dim R As Integer
Dim strCell As Variant
Dim y As Integer
Application.EnableEvents = False
Set ws = Worksheets("ProCode")
'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

'check for the product name
If Trim(Me.CbxProd.Value) = "" Then
Me.CbxProd.SetFocus
MsgBox "Please enter the product name"
Exit Sub
End If

'creates the MSDS#
dept = Me.CboDept.Text
y = 0
intMtoprow = ws.Range("M1000").End(xlUp).Row
For R = 2 To intMtoprow
strCell = ws.Cells(R, 13).Value
If InStr(strCell, dept) = 1 And _
IsNumeric(Mid(strCell, Len(dept) + 1)) Then
x = CInt(Mid(strCell, Len(dept) + 1))
If x > y Then
y = x
End If
End If
Next R
'copy the data to the database

ws.Cells(iRow, 2).Value = Me.CbxProd.Value
ws.Cells(iRow, 3).Value = IIf(Me.CkBox1.Value, "Yes", "No")
ws.Cells(iRow, 4).Value = IIf(Me.CkBox2.Value, "Yes", "No")
ws.Cells(iRow, 5).Value = IIf(Me.CkBox3.Value, "Yes", "No")
ws.Cells(iRow, 6).Value = Me.CboFire.Value
ws.Cells(iRow, 7).Value = Me.CboHealth.Value
ws.Cells(iRow, 8).Value = Me.CboReact.Value
ws.Cells(iRow, 9).Value = Me.CboSpec.Value
ws.Cells(iRow, 10).Value = Me.CboDisp.Value
ws.Cells(iRow, 11).Value = Me.TxtQuan.Value
ws.Cells(iRow, 12).Value = Me.TxtDate.Value
ws.Cells(iRow, 13).Value = dept & Format(y + 1, "00#")

Application.EnableEvents = True

'the sort will fire with this line.
ws.Cells(iRow, 1).Value = Me.CbxMfg.Value
'FrmProduct.CbxMfg.Value = Me.TxtMan.Value

'clear the data
Me.CbxMfg.Value = ""
Me.CbxProd.Value = ""
Me.CkBox1.Value = False
Me.CkBox2.Value = False
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 = ""
End Sub

Private Sub BtnClose_Click()
FrmProduct.Hide
StrtUpFrm.Show
End Sub

Private Sub BtnDelete_Click()
Dim fRow As Long

On Error GoTo ender
'finds product name in column 'B' _
then deletes the entire column
fRow = Columns(2).Find(What:=CbxProd.Value, _
After:=Cells(5000, 2), LookIn:=xlFormulas, _
LookAT:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False).Row
Rows(fRow).Delete
Exit Sub
Me.CboMan.Value = ""
Me.TxtProd.Value = ""
Me.CkBox1.Value = False
Me.CkBox2.Value = False
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 CboMan_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
FrmProduct.Hide
FrmManu.Show
End Sub

Private Sub CbxMfg_Change()
Dim R As Range
Dim MfgName As String

If bEnableEvents = False Then
Exit Sub
End If

With Me.CbxMfg
If .ListIndex >= 0 Then
MfgName = .List(.ListIndex)
End If
End With

bEnableEvents = False
With Me.CbxProd
..Clear
For Each R In MfgRange
If R.Text = MfgName Then
If R(1, 2).Text <> vbNullString Then
.AddItem R(1, 2).Text
End If
End If
Next R

If .ListCount > 0 Then
.ListIndex = 0
End If

bEnableEvents = True
If .ListCount = 0 Then
MsgBox "This is a new Manufacturer add the product Information."
End If
End With

End Sub

Private Sub TxtDate_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
FrmCalendar.Show
End Sub

Private Sub UserForm_Initialize()
Dim Coll As Collection
Dim MfgName As String
Dim P As Range
Dim N As Long

Set Coll = New Collection
Set MfgRange = Worksheets("ProCode").Range("A2:A1000")
Set ProdRange = Worksheets("ProCode").Range("B2:B1000")

On Error Resume Next
For Each P In MfgRange
Coll.Add Item:=P, key:=P
Next P

bEnableEvents = False
With Me.CbxMfg
.Clear
For N = 1 To Coll.Count
.AddItem Coll(N)
Next N
If .ListCount > 0 Then
.ListIndex = 0
MfgName = .List(0)
For Each P In MfgRange
If P.Text = MfgName Then
Me.CbxProd.AddItem P(1, 2).Text
End If
Next P
If Me.CbxProd.ListCount > 0 Then
Me.CbxProd.ListIndex = 0
End If
End If
End With
bEnableEvents = True

CboFire.List = Sheets("Lists").Range("D2:D5").Value
CboHealth.List = Sheets("Lists").Range("D2:D5").Value
CboReact.List = Sheets("Lists").Range("D2:D5").Value
CboDisp.List = Sheets("Lists").Range("E2:E4").Value
CboDept.List = Sheets("Lists").Range("C2:C10").Value
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
MsgBox "Please use the 'CLOSE' button", vbExclamation
End If
End Sub
 

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

Top