Adjusting a Macro


T

TGalin

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
 
Ad

Advertisements

J

Jacob Skaria

Hi dear

Along with the two macros can you paste the general declarations as well so
as to recreate the issue.

If this post helps please click Yes
 
S

Sheeloo

Function LastRow(sh As Worksheet)
seems to the problem... Do you still have this when you remove Sub
CopyRangeFromMultiWorksheets()

Change the variable LastRow in Sub MakeQuestions()
to another name... You are using both a variable and a FUNCTION with the
same name...
Statement
LastRow = .Range("E" & Rows.Count).End(xlUp).Row
is treating LastRow as a FUNCTION...
 
J

Jim Cone

I think Sheeloo found the issue and Jacob has very good advice.
However, one more possible issue ...
Are Questions and Quest separate items or a mistake?
 
F

FSt1

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
 
T

TGalin

Sheeloo, you hit the nail on the head. I changed the variable LastRow in Sub
MakeQuestions() to another name... FinalRow = .Range("E" &
Rows.Count).End(xlUp).Row, and everything works. Thanks so much for you're
help.
 
Ad

Advertisements

R

Rick Rothstein

this line.
LastRow = .Range("E" & Rows.Count).End(xlUp).Row
should be...
LastRow = .Range(rows.count,"E").End(xlUp).Row

Actually, there is nothing wrong with the LastRow statement the OP used...
it works fine. Think about it... it starts the upward search from the last
cell in the column which is what your suggestion would have done except for
the mistype that you made in it (you should have used the Cells property of
the Worksheet object instead of the Range property).
 
T

TGalin

Thank you for you're input. I was able to resolve the problem. 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, thanks so much
for you're help and advice.
 
T

TGalin

Hi Jim, you are right! 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.
 
T

TGalin

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.
 
Ad

Advertisements

T

TGalin

Thanks for you're feedback. I appreciate you're input. Sheeloo, you hit the
nail on the head. It was advised to change the variable LastRow in Sub
MakeQuestions() to another name... FinalRow = .Range("E" &
Rows.Count).End(xlUp).Row, I did and everything works now. By the way, I
really like you're summary sheet macro; it works great. Thanks so much for
you're help.
 
Ad

Advertisements


Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top