Deleting Rows in Case Statement

[SeventhFloorProfessor]

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

 

[Patrick Molloy]

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

 

[Patrick Molloy]

questions in cols C thro V (ie 20)
ask for >20 then the extra columns are added - copied from V
ask for less than 20, the extra colemns are 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

'formats the Grade (Display) sheet by adding correct number of questions
'Windows(wbAssess).Activate

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