I have the following code for a Resume Question Function for a Questionaire I'm creating in Excel. Problem is that When you resume, it should start the Questions from the Last Row. It doesn't appear to do this? Some times it'll start a few questions before the last row. I've highlighted the updated code below.
Anyone have any ideas?
Anyone have any ideas?
Rich (BB code):
Option Explicit
Dim m_Prev_QID() As Integer
Dim m_Next_QID() As Integer
Dim m_QID As Integer
Dim m_ItemNo As Integer
Dim m_Question As String
Dim m_Response As String
Dim m_Validation As String
Dim m_PCSOutput As String
Dim m_TotalUniqueQuestions As Integer
Dim strResponse As String
Private Sub cmbOptions_Change()
'Get the Option Item Number from the list
If cmbOptions.ListIndex <> -1 Then
m_ItemNo = cmbOptions.ListIndex + 1
m_Response = cmbOptions.Value
cmdNext.Enabled = True
End If
End Sub
Private Sub cmdEnd_Click()
Unload Me
End Sub
Private Sub cmdNext_Click()
If txtInput.Visible Then
Select Case m_Validation
Case "D": 'Date
' UserCalendar.Show
' txtInput.Value = UserCalendar.Calendar1.Value
If Not IsDate(m_Response) Then
MsgBox "Please enter a valid date !", vbCritical
txtInput.SetFocus
Exit Sub
Else
m_Response = Format(m_Response, "dd mm yyyy") 'changed in version 7.34. May need to add both date formats
End If
Case "P" 'Percentage
If Not IsNumeric(m_Response) Then
MsgBox "Please enter a valid % !", vbCritical
txtInput.SetFocus
Exit Sub
Else
m_Response = Format(m_Response, "0.00%")
End If
Case "N" 'Numeric - Currency - Term Lenght - Age etc
If Not IsNumeric(m_Response) Then
MsgBox "Please enter a valid Number !", vbCritical
txtInput.SetFocus
Exit Sub
Else
m_Response = CDbl(m_Response)
End If
Case "T": 'Free Flow Text
m_Response = DoSpellCheck(m_Response)
Case Else:
m_Response = m_Response
End Select
End If
strResponse = m_Response
Call SaveData(m_QID, m_Question, m_Response, m_PCSOutput)
m_QID = m_Next_QID(m_ItemNo)
Call Question_load
txtInput.Value = ""
cmbOptions.Value = "" 'Fix to Clear Combo Box Prior to New Question Load
cmdNext.Enabled = (m_Response <> "")
CmdPrevQuestion.Enabled = True
Private Sub CmdPrevQuestion_Click()
If m_QID = 1 Then
m_QID = 1
CmdPrevQuestion.Enabled = False
Else
m_QID = QID_Prev(m_Question)
Call Delete_LastRow
Call Question_load
CmdPrevQuestion.Enabled = True
End If
End Sub
Private Sub txtInput_Change()
lblChar.Caption = Len(Replace(txtInput, "", "")) & " Characters used."
cmdNext.Enabled = (txtInput.Text <> "")
'm_Validation
m_Response = txtInput.Text
' txtInput.Value = Format(m_Response, "dd mmm yy")
End Sub
Private Sub UserForm_Initialize()
Dim strCap As String
strCap = Sheets("Output").Range("C1").Value & " Statement Resumed."
userResume.Caption = strCap
'Dim reply As Integer
' reply = MsgBox("Do you wish to start from Question 1 or resume where you left off?" & vbCrLf & _
' "Yes = Start from Question 1 (any previous answers will be erased)" & vbCrLf & _
' "No = Resume from where I left off" & vbCrLf & _
' "Cancel = Exit from the program", vbYesNoCancel, "Start from Beginning or Resume")
' Select Case reply
' Case vbYes
' shOutput.Cells.Clear
' m_QID = 1
' Case vbNo
' m_QID = Application.CountA(shOutput.Columns(1)) + 1
' Case vbCancel
' End
' End Select
' m_TotalUniqueQuestions = TotalQuestions
'If m_QID > 2 Then Me.lblEdit.Visible = True
' Call Question_Load
m_QID = Application.CountA(shOutput.Columns(1)) + 1
m_TotalUniqueQuestions = TotalQuestions
Call Question_load
End Sub
Private Sub Question_load()
Dim intTotalOptions As Integer
Dim strQInfo(4) As String
Dim strOptionsID() As String
Dim strOptions() As String
Dim intOptionsControl As Integer
Dim intOptions As Integer
ReDim m_Next_QID(0)
ReDim m_Prev_QID(0)
Call Question_Detail(m_QID, strQInfo, intTotalOptions, strOptionsID, strOptions, m_Next_QID, m_Prev_QID, intOptionsControl)
'Update Memory Variables
m_Question = strQInfo(1)
m_Validation = strQInfo(3)
m_PCSOutput = strQInfo(4) 'Get PCS Output Information
m_Response = QuestionAnswer(m_Question)
m_ItemNo = 1
'Load Controls with Data
Me.Label2.Width = 361.1 * (m_QID / m_TotalUniqueQuestions)
Me.Label2.Caption = Format((m_QID / m_TotalUniqueQuestions), "0.0%")
Me.lblQID.Caption = m_QID
Me.lblQuestion.Caption = m_Question
Me.LblDesc.Caption = strQInfo(2)
'Hide all Controls
cmbOptions.Visible = False
txtInput.Visible = False
'Decide which control should be displayed
Select Case intOptionsControl
Case CTRL_OPTION:
Case CTRL_CHECKBOX:
Case CTRL_LISTBOX:
Case CTRL_COMBOBOX: 'Set Combobox
With cmbOptions
.Clear
.Visible = True
For intOptions = 1 To intTotalOptions
.AddItem strOptions(intOptions)
If strOptions(intOptions) = m_Response Then .ListIndex = intOptions - 1
Next intOptions
End With
Case CTRL_TEXTBOX:
txtInput.Value = m_Response
txtInput.Visible = True
Case Else:
txtInput.Visible = True
End Select
End Sub