Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Message box causing error in code
have a form which looks at the title of the workbook saved on a
different workbook, determines whether or not information has been inputted previously and then asks the user if the information is still correct. The code works beautifully until the message box is displayed. If the user chooses, no, then the code proceeds without error. Only if the user chooses yes is a "Run-time error '91': Object variable or With block variable not set" message is displayed. It almost appears as though the program is attempt to exit while the message box is still active, but I cannot find a while to close the message box. Below is my code, can anyone assist with this error? Private Sub Workbook_Open() Application.ScreenUpdating = False Dim iMinCellRow As Integer Dim iMaxCellRow As Integer Dim iCellValue As String Dim Ctrl As OLEObject Dim iSheet As Worksheet Dim iCol As Integer Dim Counter As Integer ThisWorkbook.Unprotect Password:="f3rg0t" ThisWorkbook.Sheets("sheet1").Visible = xlSheetVisible ThisWorkbook.Sheets("sheet1").Unprotect Password:="f3rg0t" Application.OnKey "~", "MyTabOrder" Set iSheet = ThisWorkbook.Sheets("Sheet1") iMinCellRow = 1 iMaxCellRow = 301 iCol = 1 ' Determine which cells on the sheet are available to write to For Counter = iMinCellRow To iMaxCellRow iCellValue = iSheet.Cells(Counter, iCol).Value ' Write info to text file. If (iCellValue = "") Then iSheet.Cells(Counter, iCol + 1).Value = Now Exit For End If Next Counter ThisWorkbook.Sheets("sheet1").Protect Password:="f3rg0t" ThisWorkbook.Sheets("sheet1").Visible = xlSheetHidden ThisWorkbook.Protect Password:="f3rg0t" Application.ScreenUpdating = True With Sheet1 .Activate .Cells(1, 1).Activate End With Load frmLogIn End Sub Private Sub cmdCancel_Click() Dim fValid As Boolean Dim Ctrl As Control Dim i As Integer Dim itemp1 As Integer Dim itemp2 As Integer Dim itemp3 As Integer Dim itemp4 As Integer Dim itemp5 As Integer ' Read the information from the form and validate fValid = True itemp1 = 0 itemp2 = 0 itemp3 = 0 itemp4 = 0 itemp5 = 0 For i = 1 To 31 Set Ctrl = Controls("OptionButton" & i) If i < 8 Then If Ctrl.Value = True Then itemp1 = 1 End If ElseIf ((i 7) And (i < 15)) Then If (((Ctrl.Value = True) And (i < 14)) Or ((Ctrl.Object.Value = True) And (TextBox3.Value < ""))) Then itemp2 = 1 End If ElseIf ((i 14) And (i < 22)) Then If Ctrl.Value = True Then If i = 21 Then If OptionButton23.Value = False And OptionButton24.Value = False Then itemp3 = 0 Else itemp3 = 1 End If Else itemp3 = 1 End If End If ElseIf ((i 24) And (i < 28)) Then If Ctrl.Value = True Then itemp4 = 1 End If Else If Ctrl.Value = True Then itemp5 = 1 End If End If Next i If ((TextBox1.Text = "") Or (TextBox2.Text = "") Or (TxtVersion.Text = "") Or (TextBox3.Text = "") Or (TextBox4.Text = "") Or (TextBox5.Text = "") Or (TextBox6.Text = "") Or (itemp1 = 0) Or (itemp2 = 0) Or (itemp3 = 0) Or (itemp4 = 0) Or (itemp5 = 0)) Then fValid = False MsgBox "Please complete form prior to exiting module" Exit Sub Else frmLogIn.Hide Unload frmLogIn End If End Sub Private Sub cmdOK_Click() Dim TestValue As String Dim iDateValue As Date Dim VersionValue As Variant Dim OtherValue As String Dim DBVersion As Variant Dim SerialNum As String Dim SerialNam As String Dim fValid As Boolean Dim Counter As Integer Dim Ctrl As Control Dim i As Integer Dim iCount As Integer Dim itemp1 As Integer Dim itemp2 As Integer Dim itemp3 As Integer Dim itemp4 As Integer Dim itemp5 As Integer Dim Book As Workbook Dim iMinCellRow As Integer Dim iMaxCellRow As Integer Dim iCellValue As String Dim NameCounter As Integer 'Read the information from the form and validate fValid = True itemp1 = 0 itemp2 = 0 itemp3 = 0 itemp4 = 0 itemp5 = 0 For i = 1 To 31 Set Ctrl = Controls("OptionButton" & i) If i < 8 Then If Ctrl.Value = True Then itemp1 = 1 End If ElseIf ((i 7) And (i < 15)) Then If (((Ctrl.Value = True) And (i < 14)) Or ((Ctrl.Value = True) And (TextBox3.Value < ""))) Then itemp2 = 1 End If ElseIf ((i 14) And (i < 22)) Then If Ctrl.Value = True Then If i = 21 Then If OptionButton23.Value = False And OptionButton24.Value = False Then itemp3 = 0 Else itemp3 = 1 End If Else itemp3 = 1 End If End If ElseIf ((i 24) And (i < 28)) Then If Ctrl.Value = True Then itemp4 = 1 End If Else If Ctrl.Value = True Then itemp5 = 1 End If End If Next i If ((TextBox1.Text = "") Or (TextBox2.Text = "") Or (TxtVersion.Text = "") Or (TextBox4.Text = "") Or (TextBox5.Text = "") Or (TextBox6.Text = "") Or (itemp1 = 0) Or (itemp2 = 0) Or (itemp3 = 0) Or (itemp4 = 0) Or (itemp5 = 0)) Then fValid = False MsgBox "Please complete the form!" Exit Sub End If TestValue = (TextBox1.Text) iDateValue = (TextBox2.Text) VersionValue = (TxtVersion.Text) OtherValue = (TextBox3.Text) DBVersion = (TextBox4.Text) SerialNum = (TextBox5.Text) SerialNam = (TextBox6.Text) Set Book = ActiveWorkbook Application.ScreenUpdating = False 'Open workbook Workbooks.Open Filename:=ThisWorkbook.Path & "\Data Doc.xls" Book.Activate ' Find first available row With Workbooks("Data Doc.xls").Sheets("Sheet1") Counter = 1 iCellValue = .Cells(Counter, 2).Value If iCellValue < "" Then Do Counter = Counter + 1 Loop While ((.Cells(Counter, 2).Value < "") And ((TestValue < .Cells(Counter, 1).Value) And (Book.Name < .Cells(Counter, 2).Value))) End If ' Write the values For NameCounter = Counter To 2 Step -1 If ((TestValue < .Cells(NameCounter - 1, 1).Value) And ((NameCounter - 1) < 2)) Then .Cells(Counter, 1).Value = TestValue End If Next NameCounter If .Cells(Counter, 6).Value = "" Then .Cells(Counter, 3).Value = iDateValue End If .Cells(Counter, 13).Value = VersionValue .Cells(Counter, 14).Value = DBVersion .Cells(Counter, 9).Value = SerialNum .Cells(Counter, 10).Value = SerialNam .Cells(Counter, 2).Value = Book.Name For iCount = 1 To 31 Set Ctrl = Controls("OptionButton" & iCount) If iCount < 8 Then If Ctrl.Value = True Then .Cells(Counter, 6).Value = Ctrl.Object.Caption End If ElseIf ((iCount 7) And (iCount < 15)) Then If ((Ctrl.Value = True) And (iCount < 14)) Then .Cells(Counter, 7).Value = Ctrl.Object.Caption ElseIf ((Ctrl.Value = True) And (iCount = 14)) Then .Cells(Counter, 7).Value = OtherValue End If ElseIf ((iCount 14) And (iCount < 22)) Then If ((Ctrl.Value = True) And (iCount < 21)) Then .Cells(Counter, 8).Value = Ctrl.Object.Caption ElseIf ((Ctrl.Value = True) And (iCount = 21)) Then If OptionButton23.Value = True Then .Cells(Counter, 8).Value = OptionButton23.Caption Else .Cells(Counter, 8).Value = OptionButton24.Caption End If End If ElseIf ((iCount 24) And (iCount < 28)) Then If Ctrl.Value = True Then .Cells(Counter, 11).Value = Ctrl.Object.Caption End If Else If Ctrl.Value = True Then .Cells(Counter, 12).Value = Ctrl.Object.Caption End If End If Next iCount End With 'Close workbook Workbooks("Data Doc.xls").Close SaveChanges:=True frmLogIn.Hide Unload frmLogIn End Sub Private Sub UserForm_Initialize() Dim fValid As Boolean Dim Counter As Integer Dim Ctrl As Control Dim i As Integer Dim iCount As Integer Dim itemp1 As Integer Dim itemp2 As Integer Dim itemp3 As Integer Dim itemp4 As Integer Dim itemp5 As Integer Dim Book As Workbook Dim iMinCellRow As Integer Dim iMaxCellRow As Integer Dim iCellValue As String Dim NameCounter As Integer Dim ans As String Set Book = ActiveWorkbook Application.ScreenUpdating = False 'Open workbook Workbooks.Open Filename:=ThisWorkbook.Path & "\Data Doc.xls" Book.Activate Application.ScreenUpdating = True ' Find last used row With Workbooks("Data Doc.xls").Sheets("Sheet1") Counter = 1 iCellValue = .Cells(Counter, 2).Value If iCellValue < "" Then Do Counter = Counter + 1 Loop While .Cells(Counter, 2).Value < "" End If Counter = Counter - 1 If ((.Cells(Counter, 1).Value < Application.UserName) And (.Cells(Counter, 2).Value < Book.Name) And (.Cells(Counter, 1).Value < "")) Then ' if form is empty then With Book.frmLogIn .TextBox1.Text = Application.UserName .TextBox2.Text = Now .TextBox1.SetFocus OptionButton23.Enabled = False OptionButton24.Enabled = False TextBox3.Enabled = False End With Else ' Read the values and place into form For NameCounter = Counter To 2 Step -1 If ((.Cells(NameCounter, 1).Value < "") And ((NameCounter) < 2)) Then TextBox1.Text = .Cells(Counter, 1).Value End If Next NameCounter If TextBox1.Text = "" Then TextBox1.Text = Application.UserName End If TextBox2.Text = .Cells(Counter, 3).Value TxtVersion.Text = .Cells(Counter, 13).Value TextBox4.Text = .Cells(Counter, 14).Value TextBox5.Text = .Cells(Counter, 9).Value TextBox6.Text = .Cells(Counter, 10).Value For iCount = 1 To 31 Set Ctrl = Controls("OptionButton" & iCount) If iCount < 8 Then If Ctrl.Caption = CStr(.Cells(Counter, 6).Value) Then Ctrl.Value = True End If ElseIf ((iCount 7) And (iCount < 15)) Then If ((Ctrl.Caption = .Cells(Counter, 7).Value) And (iCount < 14)) Then Ctrl.Value = True ElseIf ((TextBox3 = .Cells(Counter, 7).Value) And (iCount = 14)) Then Ctrl.Value = True TextBox3.Value = .Cells(Counter, 7).Value End If ElseIf ((iCount 14) And (iCount < 22)) Then If ((Ctrl.Caption = .Cells(Counter, 8).Value) And (iCount < 21)) Then Ctrl.Value = True ElseIf ((OptionButton23.Caption = .Cells(Counter, 8).Value) And (iCount = 21)) Then Ctrl.Value = True OptionButton23.Value = True ElseIf ((OptionButton24.Caption = .Cells(Counter, 8).Value) And (iCount = 21)) Then Ctrl.Value = True OptionButton24.Value = True End If ElseIf ((iCount 24) And (iCount < 28)) Then If Ctrl.Caption = .Cells(Counter, 11).Value Then Ctrl.Value = True End If Else If Ctrl.Caption = .Cells(Counter, 12).Value Then Ctrl.Value = True End If End If Next iCount End If End With 'Close workbook Workbooks("Data Doc.xls").Close SaveChanges:=True frmLogIn.Show ans = MsgBox("Is the information contained within this form still correct?", vbYesNo) If ans = vbYes Then Call cmdOK_Click End If End Sub *** Sent via Devdex http://www.devdex.com *** Don't just participate in USENET...get rewarded for it! |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
What's causing error message? | Excel Worksheet Functions | |||
cells without values causing error message | Excel Discussion (Misc queries) | |||
Formula Causing a Save Error Message | Excel Worksheet Functions | |||
code that might be causing error - please review and comment | Excel Programming | |||
ChartCalculate code causing error when saving workbook | Excel Programming |