Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
VB Code Issues | Excel Discussion (Misc queries) | |||
Help with code issues | Excel Programming | |||
C# VBA DLL issues | Excel Programming | |||
need help for several issues | Excel Programming | |||
backward compatibility code issues | Excel Programming |