Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help getting multible subs to work together
I have 2 userforms that rely on each other, 1 a product userform and 2 a
manufacturer userform. When the user enters in a manufacturer its suppose to check for that name from another sheet and if it doesn't find it its suppose to open the manufacturers userform for the user to enter the info of the manufacturer, which is working, the problem is when the user deletes a manufacturer it gets stuck in a loop and I get an error because it says I have not closed the top most model and I cannot figure out why. Here are the code for both userforms. If I need to explain what I'm just trying to do please let me know. Any and all assistance is greatly appreciated. I am using Office 2003. CODE FOR MANUFACTURER USERFORM 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.Text = Me.TxtMan.Text '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 BtnClose_Click() FrmManu.Hide FrmProduct.Show End Sub Private Sub BtnDelete_Click() Dim fRow As Long On Error GoTo ender fRow = Columns(1).Find(What:=TxtMan.Text, _ 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 BtnProd_Click() FrmProduct.Show 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 CODE FOR THE PRODUCT USERFORM 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 y As Integer 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.TxtProd.Value) = "" Then Me.TxtProd.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 Application.EnableEvents = False ws.Cells(iRow, 2).Value = Me.TxtProd.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.CboMan.Value FrmProduct.CboMan.Value = Me.CboMan.Value 'clear the data 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 = "" 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:=TxtProd.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_Change() Dim R As Range Dim MfgName As String If bEnableEvents = False Then Exit Sub End If With Me.CboMan If .ListIndex = 0 Then MfgName = .List(.ListIndex) End If End With With Me.CbxProd bEnableEvents = False .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 "You must first enter the manufacturer information" FrmProduct.Hide FrmManu.Show End If End With End Sub Private Sub CboMan_DblClick(ByVal Cancel As MSForms.ReturnBoolean) FrmProduct.Hide FrmManu.Show End Sub Private Sub TxtDate_DblClick(ByVal Cancel As MSForms.ReturnBoolean) FrmCalendar.Show End Sub Private Sub UserForm_Initialize() Dim MfgName As String Dim Coll As Collection Dim R 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 R In MfgRange Coll.Add Item:=R, key:=R Next R bEnableEvents = False With Me.CboMan .Clear For n = 1 To Coll.Count .AddItem Coll(n) Next n If .ListCount 0 Then .ListIndex = 0 MfgName = .List(0) For Each R In MfgRange If R.Text = MfgName Then Me.CbxProd.AddItem R(1, 2).Text End If Next R 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
HOW CAN I MERGE MULTIBLE SHEETS TO 1 SHEET | Excel Worksheet Functions | |||
Counting with multible conditions in a table | Excel Discussion (Misc queries) | |||
SUM(IF(multible conditions)) | Excel Worksheet Functions | |||
Conditional Formating multible if statements | Excel Discussion (Misc queries) | |||
Union across multible worksheets | Excel Programming |