Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 159
Default 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
Search this Thread:

Advanced Search
Display Modes

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
HOW CAN I MERGE MULTIBLE SHEETS TO 1 SHEET aysenboy Excel Worksheet Functions 2 July 25th 08 12:58 PM
Counting with multible conditions in a table Lotta Excel Discussion (Misc queries) 8 September 29th 07 08:21 PM
SUM(IF(multible conditions)) frenchy Excel Worksheet Functions 2 September 21st 06 10:58 PM
Conditional Formating multible if statements Roy Excel Discussion (Misc queries) 4 July 22nd 05 09:34 PM
Union across multible worksheets Jeff Excel Programming 1 September 29th 04 12:48 AM


All times are GMT +1. The time now is 11:22 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"