Macro Interactive Code on Excel Worksheet
Sponsor
Excel Vba Macro Interactive Code on Excel Worksheet [Q]
I have a workbook with one worksheet. The worksheet has a list of 50
questions ranging from B4:B54. I am looking for a code that will select each question randomly, arbitrarily choose 12, 16, or 24, and take these steps below while asking each question that many times (12, 16, or 24).
1) Open a message box with the question and a field for an answer. After the user gives an answer and presses enter…..
2) A new worksheet get created for that question, and a copy of the question is pasted into excel C2 cell of that new excel worksheet along with each answer that was given for the question that was asked. (The macro does not jump to the new excel worksheets that are created but it keeps a record of everything that is asked and answered so when the macro is finished all questions and answers can be reviewed.
3) At any point, the user is able to hit esc or some other keyboard command so that the excel vba macro stops at that point, without losing any of the data entered so far, and when restarted later the macro can resume the process from where it left off.
Excel Vba Macro Interactive Code on Excel Worksheet [A]
The excel vba macro solution is to have a hidden excel worksheet which contains the history information on all users. The history worksheet will have the user name in column A. the status in Colum 2 (question number of complete), The last question answered in Column C
‘Status sheet info
‘ Column A (User Name)
‘ Column B (Number of questions Selected)
‘ Column C (Last Question Number or completed)
‘ Column E+ (the list of random numbers)
My code assumes two worksheets
1) Questions
2) Status - History of users
Last question is on B53 (not B54)
I created two macros. One to create response sheets and one to ask questions.
Const Questions = 50
Const QuestSht = “Questions”
Const StatSht = “Status”
Sub TakeTest()
Dim SortArray(Questions, 2)
‘Status sheet info
‘ Column A (User Name)
‘ Column B (Number of questions Selected)
‘ Column C (Last Question Number or completed)
‘ Column E+ (the list of random numbers)
‘get user name
User = Environ(”UserName”)
With Sheets(StatSht)
‘find user
Set c = .Columns(”A”).Find(what:=User, LookIn:=xlValues, _
lookat:=xlWhole)
If c Is Nothing Then
LastRow = .Range(”A” & Rows.Count).End(xlUp).Row
UserRow = LastRow + 1
.Range(”A” & UserRow) = User
NewUser = True
Else
UserRow = c.Row
If .Range(”C” & UserRow) = “Completed” Then
NewUser = True
Else
NewUser = False
End If
End If
If NewUser = True Then
Randomize
‘Randomly choose 12 , 16, 24
Quest = Int(3 * Rnd())
Select Case Quest
Case 0: NumberofQuestions = 12
Case 1: NumberofQuestions = 16
Case 2: NumberofQuestions = 24
End Select
CurrentQuestion = 1
‘create numbers questions
For i = 1 To 50
SortArray(i, 1) = i
SortArray(i, 2) = Rnd()
Next i
’sort array to get random question
For i = 1 To NumberofQuestions
For j = i To Questions
If SortArray(j, 2) < SortArray(i, 2) Then
Temp = SortArray(i, 1)
SortArray(i, 1) = SortArray(j, 1)
SortArray(j, 1) = Temp
Temp = SortArray(i, 2)
SortArray(i, 2) = SortArray(j, 2)
SortArray(j, 2) = Temp
End If
Next j
‘Save numbers in worksheet
.Range(”E” & UserRow).Offset(0, i - 1) = _
SortArray(i, 1)
Next i
.Range(”B” & UserRow) = NumberofQuestions
.Range(”C” & UserRow) = CurrentQuestion
Else
NumberofQuestions = .Range(”B” & UserRow)
CurrentQuestion = .Range(”C” & UserRow) + 1
End If
End With
For QuestionCount = CurrentQuestion To NumberofQuestions
QuestionNumber = _
Sheets(StatSht).Range(”E” & UserRow) _
.Offset(0, QuestionCount - 1)
Set QSht = Sheets(”Quest ” & QuestionNumber)
MyTitle = “Question Count = ” & QuestionCount & ” of ” & _
NumberofQuestions & ” ” & _
“Survey Item ” & _
QuestionNumber
With QSht
MyPrompt = .Range(”A1″)
Response = InputBox(prompt:=MyPrompt, _
Title:=MyTitle)
LastRow = .Range(”A” & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
.Range(”A” & NewRow) = User
.Range(”B” & NewRow) = Response
Sheets(StatSht).Range(”C” & UserRow) = QuestionCount + 1
Response = MsgBox(prompt:=”End test”, Buttons:=vbYesNo)
If Response = vbYes Then
Exit For
End If
End With
ThisWorkbook.Save
Next QuestionCount
ThisWorkbook.Save
End Sub
Sub CreateWorksheets()
With Sheets(QuestSht)
For QuestNumber = 1 To Questions
Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = “Quest ” & QuestNumber
NewSht.Range(”A1″) = .Range(”B4″).Offset(QuestNumber - 1, 0)
NewSht.Range(”A2″) = “User”
NewSht.Range(”B2″) = “Response”
Next QuestNumber
End With
End Sub
Rate This Tips:
Incoming excel search terms
macro excel worksheet,macro coding in excel,,excel macro worksheet,excel history worksheet,macros coding in excel,interactive excel macro,interactive vba,excel vba code,interactive excel vba,vba interactive,excel interactive macro,excel macro worksheets,excel vba interactive,macro coding in ms excel,mss,vba excel worksheet,choose sheet vba,excel interactive worksheet,excel macro codes,get history in excel with macro,how can apply if formula for two sheet by vb in excel,interactive excel sheet,interactive excel spreadsheet,interactive excel worksheet,interactive worksheets in excel,interective excel macro,macro interactive,remove hyperlink in excel sheets macro,vba macro code,worksheet macro,worksheets macro,count no of records in whole workbook excel macro,delete sheet macro with msg code excel,excel macro code,excel macro coding,excel macro for find sheet names,excel macro interactive,excel macro random question,excel macro to add code to different sheet,excel macro to choose random questions from column,excel macro workbook,excel mapping from worksheet to worksheet vba code,excel sheet answer code,excel vba application interactive,excel vba choose worksheet,excel vba code to search worksheet tables,excel vba for all worksheets,excel vba set password for all worksheets,excel vba to find text on worksheets
Related Excel Tips
Comments
2 Comments on Macro Interactive Code on Excel Worksheet
-
tom on
Sat, 24th Oct 2009 7:16 am
-
vba excel on
Tue, 27th Oct 2009 6:59 am
I have a method that deletes a worksheet. When this method runs I lose all the values that are in user defined properties in myworksheet. When I comment out the actual worksheets().delete statement the values in myworksheet are retained so I know it is this one line that is causing the object to be destroyed.
Has anybody experienced this before? Am I doing something wrong?
Thanks in advance to anyone who can help me.
Tom,
Named ranges (for example) use the sheet name too in their definition. If you delete the sheet, the named range would not exist any more.
If you need the named ranges, you could create similar ranges in another sheet and name them.
I won’t be able to try and help more unless i know exactly what the user defined properties are.
Have another excel answer or questions for this problem ?
Feel free to post it here..















