LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 17
Default Message box causing error in code

This was posted yesterday, but received no responses and it appears to
have been deleted today. I have a piece of code that pulls information
from a worksheet into a userform, displays a messagebox asking the user
if the information in the form is still correct. The code runs fine as
long as the messagebox is not displayed. The code will still run
without error if the No button is selected on the messagebox, the
messagebox closes normally leaving the userform displayed. If the Yes
button is clicked, as soon as the program ends, it displays a "Run-time
error '91' Object variable or With block variable not set". Can anyone
please assist me in solving 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

Set Book = Nothing
frmLogIn.Hide
Unload frmLogIn
End Sub

*** Sent via Devdex http://www.devdex.com ***
Don't just participate in USENET...get rewarded for it!
 
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
What's causing error message? Jim Tibbetts Excel Worksheet Functions 4 November 12th 08 06:13 PM
cells without values causing error message karen Excel Discussion (Misc queries) 6 January 11th 08 06:39 PM
Formula Causing a Save Error Message Mr Mike Excel Worksheet Functions 2 September 1st 05 06:01 PM
Message box causing error in code Calligra Excel Programming 0 July 7th 04 02:46 PM
code that might be causing error - please review and comment bruce forster Excel Programming 4 May 21st 04 03:06 AM


All times are GMT +1. The time now is 01:54 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"