Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Adjusting a Macro
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
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



Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 8,520
Default Adjusting a Macro
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
---------------
Jacob Skaria


Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 81
Default Adjusting a Macro
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.



"Jacob Skaria" wrote:

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
---------------
Jacob Skaria


Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 225
Default Adjusting a Macro
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...

"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



Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 81
Default Adjusting a Macro
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.

"Sheeloo" wrote:

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

"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



Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1,549
Default Adjusting a Macro

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?
--
Jim Cone
Portland, Oregon USA

Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 81
Default Adjusting a Macro
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.

"Jim Cone" wrote:


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?
--
Jim Cone
Portland, Oregon USA


Reply With QuoteReply With Quote
  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 3,942
Default Adjusting a Macro
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



Reply With QuoteReply With Quote
  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5,934
Default Adjusting a Macro
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).

--
Rick (MVP - Excel)


"FSt1" wrote in message
...
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




Reply With QuoteReply With Quote
  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 81
Default Adjusting a Macro
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.


"Rick Rothstein" wrote:

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

--
Rick (MVP - Excel)


"FSt1" wrote in message
...
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





Reply With QuoteReply With Quote
  #11   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 81
Default 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



Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Hybrid Mode Hybrid Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Adjusting comment box size by Macro yshridhar Excel Discussion (Misc queries) 2 February 5th 08 09:19 AM
Adjusting Macro M.A.Tyler Excel Discussion (Misc queries) 2 March 24th 07 06:07 PM
adjusting a macro that retreives access data timmulla Excel Programming 1 March 7th 07 02:55 AM
Chart Adjusting Macro II [email protected] Excel Programming 3 June 5th 06 02:53 PM
Macro / VBA adjusting variable columns PaulW Excel Discussion (Misc queries) 1 April 23rd 06 08:25 AM


All times are GMT +1. The time now is 09:18 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement