Adjusting a Macro
Thanks for you're input. Quest is not a typo but you brought up a lot of
other good points that I should look into. Sheeloo, hit the nail on the head.
The instructions were to change the variable LastRow in Sub MakeQuestions()
to another name... this is what I used instead FinalRow = .Range("E" &
Rows.Count).End(xlUp).Row, and everything works now, thanks so much for
you're feedback.
"FSt1" wrote:
hi
confused!
this line.
LastRow = .Range("E" & Rows.Count).End(xlUp).Row
should be...
LastRow = .Range(rows.count,"E").End(xlUp).Row
also this line..
Select Case Quest
Quest does not appear anywhere else in the code?????
is this a typo for "question" which appear multiple times????
also your funciton at the end....not needed....if you are using...
LastRow = .Range(rows.count,"E").End(xlUp).Row(which don't work-see above)
and i can't see where it's use is needed anywhere in the code. (did you post
all or part)
also LastCol.
doesn't seem to be needed at all????? at least in the code you posted.
are we being shown all code or just the part you think is causing problems????
regards
FSt1
"TGalin" wrote:
Sub MakeQuestions() & Sub CopyRangeFromMultiWorksheets() are the two macros
that I pasted below. For some reason when I have Sub
CopyRangeFromMultiWorksheets() in my workbook Sub MakeQuestions() doesn't
work but as soon as I remove Sub CopyRangeFromMultiWorksheets() from my
workbook Sub MakeQuestions() starts working again. Sub
CopyRangeFromMultiWorksheets(), on the other hand, works regardless of
whether Sub MakeQuestions() is in the workbook or not.
When I have both Sub MakeQuestions() & Sub CopyRangeFromMultiWorksheets()
in my workbook and I try to run Sub MakeQuestions() I get a visual basic help
box with a message that reads Compile error: Argument not optional. Then the
LastRow = part of this part of the code LastRow = .Range("E" &
Rows.Count).End(xlUp).Row ....gets highlighted in blue.
Do you know how I might be able to fix this? Both macros are below.
Sub MakeQuestions()
Dim SortArray(Questions, 2)
With Sheets(StatSht)
LastRow = .Range("E" & Rows.Count).End(xlUp).Row
RowCount = LastRow + 1
End With
'Randomly choose 12 , 16, 24
Quest = Int(3 * Rnd())
Select Case Quest
Case 0: NumberofTests = 12
Case 1: NumberofTests = 16
Case 2: NumberofTests = 24
End Select
For TestNumber = 1 To NumberofTests
'create numbers questions
For I = 1 To Questions
SortArray(I, 1) = I
SortArray(I, 2) = Rnd()
Next I
Sheets(StatSht).Range("B" & RowCount) = Questions
'sort array to get random question
For I = 1 To Questions
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
With Sheets(StatSht)
'Save numbers in worksheet
.Range("E" & RowCount).Offset(0, I - 1) = _
SortArray(I, 1)
End With
Next I
RowCount = RowCount + 1
Next TestNumber
MsgBox "Click Begin Sentence Completion"
End Sub
Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Delete the sheet "RDBMergeSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True
'Add a worksheet with the name "RDBMergeSheet"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Summary Report"
'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
If IsError(Application.Match(sh.Name, _
Array(DestSh.Name, "Questions", "Status"), 0)) Then
'Find the last row with data on the DestSh
Last = LastRow(DestSh)
'Fill in the range that you want to copy
Set CopyRng = sh.Range("A1:B24")
'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If
'This example copies values/formats, if you only want to copy the
'values or want to copy everything look at the example below
this macro
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
'Optional: This will copy the sheet name in the H column
DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value =
sh.Name
End If
Next
ExitTheSub:
Application.Goto DestSh.Cells(1)
'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
|