View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
TGalin TGalin is offline
external usenet poster
 
Posts: 81
Default Adjusting a Macro

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