try this code. It assumes that the spreadsheet has data in columns 3 - 23
(C-V) ie 20 questions
If you enter a value greater than this, then column V is replicated
If you enter a number between 5 an 19, the extra columns as deleted
Option Explicit
Sub SetQuestions()
Dim numQuest As Long
'Prompt user for number of test questions
On Error Resume Next
Application.DisplayAlerts = False
Do
numQuest = Application.InputBox(Prompt:="How many questions are on this
assessment?", Title:="Number of Questions", Default:="20", Type:=1)
On Error GoTo 0
If numQuest = 0 Then Exit Sub
If numQuest < 5 Then
MsgBox "You must have at leat 5 questions. Enter 0 to exit"
End If
Loop While numQuest < 5
If numQuest > 20 Then
Range("V2:V50").Copy
Range("W2").Resize(, numQuest - 20).PasteSpecial xlPasteAll
Application.CutCopyMode = False
ElseIf numQuest < 20 Then
With Columns(23).Resize(, 20 - numQuest).Offset(, numQuest - 20)
.Columns.Delete
End With
End If
End Sub
"SeventhFloorProfessor" <(E-Mail Removed)>
wrote in message news:A04B12D2-9604-4E6D-A77D-(E-Mail Removed)...
>I have a worksheet "Grade (Display)" that is used to store whether or not a
> group of students correctly answered questions on a test/quiz. I have
> created
> this worksheet to be used by other teachers, so I have had to make it
> dynamic
> (as much as I am capable) by allowing the teacher to choose the number of
> students and the number of questions for each test. The macro then alters
> the
> template (which is set to 25 students in rows 4 - 28 and 20 questions in
> columns C - V) to fit what the teacher needs.
>
> After the Input Box below, the If statement adds columns (if the number of
> questions needed is greater than 20) or deletes columns (if the number is
> between 5 and 19).
>
> The macro is also set to run as soon as the workbook is opened. When I
> open
> the workbook, now, it gives me an error in my Case Statement (which
> deletes
> columns when the number of questions is between 5 and 19) related to the
> "Select" command that comes after the "Range".
>
> The code is below... any help with this problem (or with any of the code
> below) would be appreciated. I'm a novice, still. I teach literature and
> what
> I have learned has come from this board or the Help section in Excel, so
> it's
> easy to confuse me. :-)
>
> Code:
>
> 'Prompt user for number of test questions
> On Error Resume Next
> Application.DisplayAlerts = False
> numQuest = Application.InputBox(Prompt:="How many questions are on this
> assessment?", title:="Number of Questions", Default:="20", Type:=1)
> On Error GoTo 0
>
> 'formats the Grade (Display) sheet by adding correct number of questions
> Windows(wbAssess).Activate
> questNum = 20
> Do
> If numQuest > 20 Then
> Range("T2:T33").Select
> Selection.Copy
> Selection.Insert Shift:=xlToRight
> Application.CutCopyMode = False
> questNum = questNum + 1
> End If
> Loop Until questNum = numQuest
> Select Case numQuest = 19
> Range("V2:V32").Select
> Selection.Delete Shift:=xlToLeft
> Case numQuest = 18
> Range("U2:V32").Select
> Selection.Delete Shift:=xlToLeft
> Case numQuest = 17
> Range("T2:V32").Select
> Selection.Delete Shift:=xlToLeft
> Case numQuest = 16
> Range("S2:V32").Select
> Selection.Delete Shift:=xlToLeft
> Case numQuest = 15
> Range("R2:V32").Select
> Selection.Delete Shift:=xlToLeft
> Case numQuest = 14
> Range("Q2:V32").Select
> Selection.Delete Shift:=xlToLeft
> Case numQuest = 13
> Range("P2:V32").Select
> Selection.Delete Shift:=xlToLeft
> Case numQuest = 12
> Range("O2:V32").Select
> Selection.Delete Shift:=xlToLeft
> Case numQuest = 11
> Range("N2:V32").Select
> Selection.Delete Shift:=xlToLeft
> Case numQuest = 10
> Range("M2:V32").Select
> Selection.Delete Shift:=xlToLeft
> Case numQuest = 9
> Range("=L2:V32").Select
> Selection.Delete Shift:=xlToLeft
> Case numQuest = 8
> Range("=K2:V32").Select
> Selection.Delete Shift:=xlToLeft
> Case numQuest = 7
> Range("=J2:V32").Select
> Selection.Delete Shift:=xlToLeft
> Case numQuest = 6
> Range("=I2:V32").Select
> Selection.Delete Shift:=xlToLeft
> Case numQuest = 5
> Range("=H2:V32").Select
> Selection.Delete Shift:=xlToLeft
> Case numQuest > 5
> MsgBox "You must have at least five questions!"
>
> questNum = 0
> Range("C2:C3").Select
> Do
> questNum = questNum + 1
> ActiveCell.value = questNum
> ActiveCell.Offset(0, 1).Select
> Loop Until questNum = numQuest
> questNum = 1
|
Similar Threads
