Finding max and min across multiple sheets
 

I have a rather large data set of monthly stock prices for 349 Danish
companies. So the data set is in two sheets due to the limits of 256 columns.
The data set starts in cell "B8" and goes until "FZ8" in both sheets and
continues until row 414
I need a code which sums 3 months return across all companies starting with
"B8" + "B9" + "B10" till "FZ8" + "FZ9" + "FZ10" and afterwards illustrates
the ten largest and smallest 3 month returns across the two sheets by marking
the final cell for example "B10". (optimally it would store the name of the
companies with the relevant month in another sheet)
I need to incorporate a loop as well so the above mentioned macro continues
with summing and illustrating the ten largest and smallest three month
returns. "B9"+"B10"+"B11" all the way to "B412"+"B413"+"B414"

Untill now i have created the following code but there are three problems:
- I do not know how to incorporate the sum macro with the "application.large"
- The loop doesn't work
- The code only works in the active sheet - It cannot look across the two
sheets!

Here is the code:

Public Sub ProcessAllWorksheets()
Dim arr As Variant
Dim answer As Double
Dim totalAnswer As Double
Dim rng As Range, rng1 As Range
Dim l As Double, s As Double
Dim cell As Range

arr = Array("MAK", "MKW")
Sheets(arr).Select

For j = 1 To 9
Set rng = Range("B10").Resize(j, 181)
rng.Interior.ColorIndex = xlNone
l = Application.Large(rng, 10)
s = Application.Small(rng, 10)

For Each cell In rng
If IsNumeric(cell) And _
Not IsEmpty(cell) And cell.Text < "" Then
If cell.Value = l Then
cell.Interior.ColorIndex = 5
ElseIf cell.Value <= s Then
cell.Interior.ColorIndex = 3
End If
End If
Next
Next j
End Sub

Finding max and min across multiple sheets
 

Select highlights only one range of cells. I prefer using a set command that
allows multiple ranges to be defined and used later in a program. like

MyRange1 = Range("Sheet1!a2:f7)
MyRange2 = Range("Sheet2!a9:j10)

A Union can be used to combine multiple ranges

Set BigRange = Application.Union(Range(MyRange!), Range(MyRange2))



"The danish student" wrote:

I have a rather large data set of monthly stock prices for 349 Danish
companies. So the data set is in two sheets due to the limits of 256 columns.
The data set starts in cell "B8" and goes until "FZ8" in both sheets and
continues until row 414
I need a code which sums 3 months return across all companies starting with
"B8" + "B9" + "B10" till "FZ8" + "FZ9" + "FZ10" and afterwards illustrates
the ten largest and smallest 3 month returns across the two sheets by marking
the final cell for example "B10". (optimally it would store the name of the
companies with the relevant month in another sheet)
I need to incorporate a loop as well so the above mentioned macro continues
with summing and illustrating the ten largest and smallest three month
returns. "B9"+"B10"+"B11" all the way to "B412"+"B413"+"B414"

Untill now i have created the following code but there are three problems:
- I do not know how to incorporate the sum macro with the "application.large"
- The loop doesn't work
- The code only works in the active sheet - It cannot look across the two
sheets!

Here is the code:

Public Sub ProcessAllWorksheets()
Dim arr As Variant
Dim answer As Double
Dim totalAnswer As Double
Dim rng As Range, rng1 As Range
Dim l As Double, s As Double
Dim cell As Range

arr = Array("MAK", "MKW")
Sheets(arr).Select

For j = 1 To 9
Set rng = Range("B10").Resize(j, 181)
rng.Interior.ColorIndex = xlNone
l = Application.Large(rng, 10)
s = Application.Small(rng, 10)

For Each cell In rng
If IsNumeric(cell) And _
Not IsEmpty(cell) And cell.Text < "" Then
If cell.Value = l Then
cell.Interior.ColorIndex = 5
ElseIf cell.Value <= s Then
cell.Interior.ColorIndex = 3
End If
End If
Next
Next j
End Sub

Finding max and min across multiple sheets
 

Sub ProcessAllWorksheets()
Dim arr As Variant
Dim rng As Range, rng1 As Range
Dim cell As Range
Dim j As Long
ReDim arr(1 To 405, 1 To 2) As Variant

For j = 8 To 412
Set rng = Worksheets("MAK").Cells(j, 2).Resize(3, 181)
Set rng1 = Worksheets("MKW").Cells(j, 2).Resize(3, 181)
arr(j - 7, 1) = Cells(j + 2, 2).Address
arr(j - 7, 2) = Application.Sum(rng, rng1)
Next j

QuickSort arr, 2, 1, 405, True

' the next lines allow you to check the array if you wish
' just uncomment them and it will add a sheet an place the array
'Set sh = Worksheets.Add(After:=Worksheets(Worksheets.Count) )
'Range("A1:B405").Value = arr

' 10 smallest
For i = 1 To 10
Set rng = Worksheets("Mak").Range(arr(i, 1))
rng.Interior.ColorIndex = 3
Next
' 10 largest
For i = 405 To 396 Step -1
Set rng = Worksheets("Mak").Range(arr(i, 1))
rng.Interior.ColorIndex = 5
Next i
End Sub

Sub QuickSort(SortArray, col, L, R, bAscending)
'
'Originally Posted by Jim Rech 10/20/98 Excel.Programming
'Modified to sort on first column of a two dimensional array
'Modified to handle a second dimension greater than 1 (or zero)
'Modified to do Ascending or Descending
Dim i, j, X, Y, mm


i = L
j = R
X = SortArray((L + R) / 2, col)
If bAscending Then
While (i <= j)
While (SortArray(i, col) < X And i < R)
i = i + 1
Wend
While (X < SortArray(j, col) And j L)
j = j - 1
Wend
If (i <= j) Then
For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, mm)
SortArray(i, mm) = SortArray(j, mm)
SortArray(j, mm) = Y
Next mm
i = i + 1
j = j - 1
End If
Wend
Else
While (i <= j)
While (SortArray(i, col) X And i < R)
i = i + 1
Wend
While (X SortArray(j, col) And j L)
j = j - 1
Wend
If (i <= j) Then
For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, mm)
SortArray(i, mm) = SortArray(j, mm)
SortArray(j, mm) = Y
Next mm
i = i + 1
j = j - 1
End If
Wend
End If
If (L < j) Then Call QuickSort(SortArray, col, L, j, bAscending)
If (i < R) Then Call QuickSort(SortArray, col, i, R, bAscending)
End Sub

--
Regards,
Tom Ogilvy


"The dan
ish student" wrote in message
...
I have a rather large data set of monthly stock prices for 349 Danish
companies. So the data set is in two sheets due to the limits of 256
columns.
The data set starts in cell "B8" and goes until "FZ8" in both sheets and
continues until row 414
I need a code which sums 3 months return across all companies starting
with
"B8" + "B9" + "B10" till "FZ8" + "FZ9" + "FZ10" and afterwards illustrates
the ten largest and smallest 3 month returns across the two sheets by
marking
the final cell for example "B10". (optimally it would store the name of
the
companies with the relevant month in another sheet)
I need to incorporate a loop as well so the above mentioned macro
continues
with summing and illustrating the ten largest and smallest three month
returns. "B9"+"B10"+"B11" all the way to "B412"+"B413"+"B414"

Untill now i have created the following code but there are three problems:
- I do not know how to incorporate the sum macro with the
"application.large"
- The loop doesn't work
- The code only works in the active sheet - It cannot look across the two
sheets!

Here is the code:

Public Sub ProcessAllWorksheets()
Dim arr As Variant
Dim answer As Double
Dim totalAnswer As Double
Dim rng As Range, rng1 As Range
Dim l As Double, s As Double
Dim cell As Range

arr = Array("MAK", "MKW")
Sheets(arr).Select

For j = 1 To 9
Set rng = Range("B10").Resize(j, 181)
rng.Interior.ColorIndex = xlNone
l = Application.Large(rng, 10)
s = Application.Small(rng, 10)

For Each cell In rng
If IsNumeric(cell) And _
Not IsEmpty(cell) And cell.Text < "" Then
If cell.Value = l Then
cell.Interior.ColorIndex = 5
ElseIf cell.Value <= s Then
cell.Interior.ColorIndex = 3
End If
End If
Next
Next j
End Sub

Finding max and min across multiple sheets
 

My understanding is that VBA range variables cannot refer to ranges on
different sheets. If you try this code, you will see that you get a run-time
error (I do anyway).


"Joel" wrote:

Select highlights only one range of cells. I prefer using a set command that
allows multiple ranges to be defined and used later in a program. like

MyRange1 = Range("Sheet1!a2:f7)
MyRange2 = Range("Sheet2!a9:j10)

A Union can be used to combine multiple ranges

Set BigRange = Application.Union(Range(MyRange!), Range(MyRange2))



"The danish student" wrote:

I have a rather large data set of monthly stock prices for 349 Danish
companies. So the data set is in two sheets due to the limits of 256 columns.
The data set starts in cell "B8" and goes until "FZ8" in both sheets and
continues until row 414
I need a code which sums 3 months return across all companies starting with
"B8" + "B9" + "B10" till "FZ8" + "FZ9" + "FZ10" and afterwards illustrates
the ten largest and smallest 3 month returns across the two sheets by marking
the final cell for example "B10". (optimally it would store the name of the
companies with the relevant month in another sheet)
I need to incorporate a loop as well so the above mentioned macro continues
with summing and illustrating the ten largest and smallest three month
returns. "B9"+"B10"+"B11" all the way to "B412"+"B413"+"B414"

Untill now i have created the following code but there are three problems:
- I do not know how to incorporate the sum macro with the "application.large"
- The loop doesn't work
- The code only works in the active sheet - It cannot look across the two
sheets!

Here is the code:

Public Sub ProcessAllWorksheets()
Dim arr As Variant
Dim answer As Double
Dim totalAnswer As Double
Dim rng As Range, rng1 As Range
Dim l As Double, s As Double
Dim cell As Range

arr = Array("MAK", "MKW")
Sheets(arr).Select

For j = 1 To 9
Set rng = Range("B10").Resize(j, 181)
rng.Interior.ColorIndex = xlNone
l = Application.Large(rng, 10)
s = Application.Small(rng, 10)

For Each cell In rng
If IsNumeric(cell) And _
Not IsEmpty(cell) And cell.Text < "" Then
If cell.Value = l Then
cell.Interior.ColorIndex = 5
ElseIf cell.Value <= s Then
cell.Interior.ColorIndex = 3
End If
End If
Next
Next j
End Sub

Finding max and min across multiple sheets
 

Thanks for the quick and thoroughly reply.

It seems that I have not expressed myself precise enough.

What I need is to get the 3 month post return for two separate portfolios
respectively: the ten companies with the lowest and the highest prior
three-month return for each of the 402 months. This means that I hopefully
will end up with a formation period of three month and a holding period of
three month (overlapping time periods).
The first holding period starts in row 11 and ends in row 13 and is based on
the returns from row 8+9+10 (formation period). So the first relevant return
is achieved in row 13 (the sum of row 11+12+13), which means that our
portfolio 1 will end up containing only the returns from the top ten
companies from the formation period. Similar portfolio 2 will only contain
returns from the bottom ten companies from the formation period.

To sum up €œloop 1€� goes from row 8-13
Loop 2 goes from row 9-14 etc.

Ideally the code should create an array in another worksheet for each month
starting in row 13 with the aggregate returns for the two portfolios and the
ten company names in each of the two portfolios (company names are positioned
in row 4)

If I am still not able to explain myself :-) I would gladly send a copy of
my Excel spreadsheet.


"Tom Ogilvy" wrote:

Sub ProcessAllWorksheets()
Dim arr As Variant
Dim rng As Range, rng1 As Range
Dim cell As Range
Dim j As Long
ReDim arr(1 To 405, 1 To 2) As Variant

For j = 8 To 412
Set rng = Worksheets("MAK").Cells(j, 2).Resize(3, 181)
Set rng1 = Worksheets("MKW").Cells(j, 2).Resize(3, 181)
arr(j - 7, 1) = Cells(j + 2, 2).Address
arr(j - 7, 2) = Application.Sum(rng, rng1)
Next j

QuickSort arr, 2, 1, 405, True

' the next lines allow you to check the array if you wish
' just uncomment them and it will add a sheet an place the array
'Set sh = Worksheets.Add(After:=Worksheets(Worksheets.Count) )
'Range("A1:B405").Value = arr

' 10 smallest
For i = 1 To 10
Set rng = Worksheets("Mak").Range(arr(i, 1))
rng.Interior.ColorIndex = 3
Next
' 10 largest
For i = 405 To 396 Step -1
Set rng = Worksheets("Mak").Range(arr(i, 1))
rng.Interior.ColorIndex = 5
Next i
End Sub

Sub QuickSort(SortArray, col, L, R, bAscending)
'
'Originally Posted by Jim Rech 10/20/98 Excel.Programming
'Modified to sort on first column of a two dimensional array
'Modified to handle a second dimension greater than 1 (or zero)
'Modified to do Ascending or Descending
Dim i, j, X, Y, mm


i = L
j = R
X = SortArray((L + R) / 2, col)
If bAscending Then
While (i <= j)
While (SortArray(i, col) < X And i < R)
i = i + 1
Wend
While (X < SortArray(j, col) And j L)
j = j - 1
Wend
If (i <= j) Then
For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, mm)
SortArray(i, mm) = SortArray(j, mm)
SortArray(j, mm) = Y
Next mm
i = i + 1
j = j - 1
End If
Wend
Else
While (i <= j)
While (SortArray(i, col) X And i < R)
i = i + 1
Wend
While (X SortArray(j, col) And j L)
j = j - 1
Wend
If (i <= j) Then
For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, mm)
SortArray(i, mm) = SortArray(j, mm)
SortArray(j, mm) = Y
Next mm
i = i + 1
j = j - 1
End If
Wend
End If
If (L < j) Then Call QuickSort(SortArray, col, L, j, bAscending)
If (i < R) Then Call QuickSort(SortArray, col, i, R, bAscending)
End Sub

--
Regards,
Tom Ogilvy


"The dan
ish student" wrote in message
...
I have a rather large data set of monthly stock prices for 349 Danish
companies. So the data set is in two sheets due to the limits of 256
columns.
The data set starts in cell "B8" and goes until "FZ8" in both sheets and
continues until row 414
I need a code which sums 3 months return across all companies starting
with
"B8" + "B9" + "B10" till "FZ8" + "FZ9" + "FZ10" and afterwards illustrates
the ten largest and smallest 3 month returns across the two sheets by
marking
the final cell for example "B10". (optimally it would store the name of
the
companies with the relevant month in another sheet)
I need to incorporate a loop as well so the above mentioned macro
continues
with summing and illustrating the ten largest and smallest three month
returns. "B9"+"B10"+"B11" all the way to "B412"+"B413"+"B414"

Untill now i have created the following code but there are three problems:
- I do not know how to incorporate the sum macro with the
"application.large"
- The loop doesn't work
- The code only works in the active sheet - It cannot look across the two
sheets!

Here is the code:

Public Sub ProcessAllWorksheets()
Dim arr As Variant
Dim answer As Double
Dim totalAnswer As Double
Dim rng As Range, rng1 As Range
Dim l As Double, s As Double
Dim cell As Range

arr = Array("MAK", "MKW")
Sheets(arr).Select

For j = 1 To 9
Set rng = Range("B10").Resize(j, 181)
rng.Interior.ColorIndex = xlNone
l = Application.Large(rng, 10)
s = Application.Small(rng, 10)

For Each cell In rng
If IsNumeric(cell) And _
Not IsEmpty(cell) And cell.Text < "" Then
If cell.Value = l Then
cell.Interior.ColorIndex = 5
ElseIf cell.Value <= s Then
cell.Interior.ColorIndex = 3
End If
End If
Next
Next j
End Sub

Finding max and min across multiple sheets
 

you want your existing code to loop over sheets?

Public Sub ProcessAllWorksheets()
Dim arr As Variant
Dim answer As Double
Dim totalAnswer As Double
Dim rng As Range, rng1 As Range
Dim l As Double, s As Double
Dim cell As Range, i as Long

arr = Array("MAK", "MKW")
Sheets(arr).Select

for i = lbound(arr) to ubound(arr)
set sh = Worksheets(arr(i))
For j = 1 To 9
Set rng = sh.Range("B10").Resize(j, 181)
rng.Interior.ColorIndex = xlNone
l = Application.Large(rng, 10)
s = Application.Small(rng, 10)

For Each cell In rng
If IsNumeric(cell) And _
Not IsEmpty(cell) And cell.Text < "" Then
If cell.Value = l Then
cell.Interior.ColorIndex = 5
ElseIf cell.Value <= s Then
cell.Interior.ColorIndex = 3
End If
End If
Next
Next j
Next i
End Sub

there you go. You can work out the interior details.

--
Regards,
Tom Ogilvy


"The danish student" wrote in
message ...
Thanks for the quick and thoroughly reply.

It seems that I have not expressed myself precise enough.

What I need is to get the 3 month post return for two separate portfolios
respectively: the ten companies with the lowest and the highest prior
three-month return for each of the 402 months. This means that I hopefully
will end up with a formation period of three month and a holding period of
three month (overlapping time periods).
The first holding period starts in row 11 and ends in row 13 and is based
on
the returns from row 8+9+10 (formation period). So the first relevant
return
is achieved in row 13 (the sum of row 11+12+13), which means that our
portfolio 1 will end up containing only the returns from the top ten
companies from the formation period. Similar portfolio 2 will only contain
returns from the bottom ten companies from the formation period.

To sum up "loop 1" goes from row 8-13
Loop 2 goes from row 9-14 etc.

Ideally the code should create an array in another worksheet for each
month
starting in row 13 with the aggregate returns for the two portfolios and
the
ten company names in each of the two portfolios (company names are
positioned
in row 4)

If I am still not able to explain myself :-) I would gladly send a copy of
my Excel spreadsheet.


"Tom Ogilvy" wrote:

Sub ProcessAllWorksheets()
Dim arr As Variant
Dim rng As Range, rng1 As Range
Dim cell As Range
Dim j As Long
ReDim arr(1 To 405, 1 To 2) As Variant

For j = 8 To 412
Set rng = Worksheets("MAK").Cells(j, 2).Resize(3, 181)
Set rng1 = Worksheets("MKW").Cells(j, 2).Resize(3, 181)
arr(j - 7, 1) = Cells(j + 2, 2).Address
arr(j - 7, 2) = Application.Sum(rng, rng1)
Next j

QuickSort arr, 2, 1, 405, True

' the next lines allow you to check the array if you wish
' just uncomment them and it will add a sheet an place the array
'Set sh = Worksheets.Add(After:=Worksheets(Worksheets.Count) )
'Range("A1:B405").Value = arr

' 10 smallest
For i = 1 To 10
Set rng = Worksheets("Mak").Range(arr(i, 1))
rng.Interior.ColorIndex = 3
Next
' 10 largest
For i = 405 To 396 Step -1
Set rng = Worksheets("Mak").Range(arr(i, 1))
rng.Interior.ColorIndex = 5
Next i
End Sub

Sub QuickSort(SortArray, col, L, R, bAscending)
'
'Originally Posted by Jim Rech 10/20/98 Excel.Programming
'Modified to sort on first column of a two dimensional array
'Modified to handle a second dimension greater than 1 (or zero)
'Modified to do Ascending or Descending
Dim i, j, X, Y, mm


i = L
j = R
X = SortArray((L + R) / 2, col)
If bAscending Then
While (i <= j)
While (SortArray(i, col) < X And i < R)
i = i + 1
Wend
While (X < SortArray(j, col) And j L)
j = j - 1
Wend
If (i <= j) Then
For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, mm)
SortArray(i, mm) = SortArray(j, mm)
SortArray(j, mm) = Y
Next mm
i = i + 1
j = j - 1
End If
Wend
Else
While (i <= j)
While (SortArray(i, col) X And i < R)
i = i + 1
Wend
While (X SortArray(j, col) And j L)
j = j - 1
Wend
If (i <= j) Then
For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, mm)
SortArray(i, mm) = SortArray(j, mm)
SortArray(j, mm) = Y
Next mm
i = i + 1
j = j - 1
End If
Wend
End If
If (L < j) Then Call QuickSort(SortArray, col, L, j, bAscending)
If (i < R) Then Call QuickSort(SortArray, col, i, R, bAscending)
End Sub

--
Regards,
Tom Ogilvy


"The dan
ish student" wrote in
message
...
I have a rather large data set of monthly stock prices for 349 Danish
companies. So the data set is in two sheets due to the limits of 256
columns.
The data set starts in cell "B8" and goes until "FZ8" in both sheets
and
continues until row 414
I need a code which sums 3 months return across all companies starting
with
"B8" + "B9" + "B10" till "FZ8" + "FZ9" + "FZ10" and afterwards
illustrates
the ten largest and smallest 3 month returns across the two sheets by
marking
the final cell for example "B10". (optimally it would store the name of
the
companies with the relevant month in another sheet)
I need to incorporate a loop as well so the above mentioned macro
continues
with summing and illustrating the ten largest and smallest three month
returns. "B9"+"B10"+"B11" all the way to "B412"+"B413"+"B414"

Untill now i have created the following code but there are three
problems:
- I do not know how to incorporate the sum macro with the
"application.large"
- The loop doesn't work
- The code only works in the active sheet - It cannot look across the
two
sheets!

Here is the code:

Public Sub ProcessAllWorksheets()
Dim arr As Variant
Dim answer As Double
Dim totalAnswer As Double
Dim rng As Range, rng1 As Range
Dim l As Double, s As Double
Dim cell As Range

arr = Array("MAK", "MKW")
Sheets(arr).Select

For j = 1 To 9
Set rng = Range("B10").Resize(j, 181)
rng.Interior.ColorIndex = xlNone
l = Application.Large(rng, 10)
s = Application.Small(rng, 10)

For Each cell In rng
If IsNumeric(cell) And _
Not IsEmpty(cell) And cell.Text < "" Then
If cell.Value = l Then
cell.Interior.ColorIndex = 5
ElseIf cell.Value <= s Then
cell.Interior.ColorIndex = 3
End If
End If
Next
Next j
End Sub

Finding max and min across multiple sheets
 

Hi Tom

I need the code to loop over the two sheets as if they were one.

Right now it finds the ten biggest/smallest in each month in both sheets. I
need to find the ten biggest/smallest all in all across the two sheets:

Thank you

"Tom Ogilvy" wrote:

you want your existing code to loop over sheets?

Public Sub ProcessAllWorksheets()
Dim arr As Variant
Dim answer As Double
Dim totalAnswer As Double
Dim rng As Range, rng1 As Range
Dim l As Double, s As Double
Dim cell As Range, i as Long

arr = Array("MAK", "MKW")
Sheets(arr).Select

for i = lbound(arr) to ubound(arr)
set sh = Worksheets(arr(i))
For j = 1 To 9
Set rng = sh.Range("B10").Resize(j, 181)
rng.Interior.ColorIndex = xlNone
l = Application.Large(rng, 10)
s = Application.Small(rng, 10)

For Each cell In rng
If IsNumeric(cell) And _
Not IsEmpty(cell) And cell.Text < "" Then
If cell.Value = l Then
cell.Interior.ColorIndex = 5
ElseIf cell.Value <= s Then
cell.Interior.ColorIndex = 3
End If
End If
Next
Next j
Next i
End Sub

there you go. You can work out the interior details.

--
Regards,
Tom Ogilvy


"The danish student" wrote in
message ...
Thanks for the quick and thoroughly reply.

It seems that I have not expressed myself precise enough.

What I need is to get the 3 month post return for two separate portfolios
respectively: the ten companies with the lowest and the highest prior
three-month return for each of the 402 months. This means that I hopefully
will end up with a formation period of three month and a holding period of
three month (overlapping time periods).
The first holding period starts in row 11 and ends in row 13 and is based
on
the returns from row 8+9+10 (formation period). So the first relevant
return
is achieved in row 13 (the sum of row 11+12+13), which means that our
portfolio 1 will end up containing only the returns from the top ten
companies from the formation period. Similar portfolio 2 will only contain
returns from the bottom ten companies from the formation period.

To sum up "loop 1" goes from row 8-13
Loop 2 goes from row 9-14 etc.

Ideally the code should create an array in another worksheet for each
month
starting in row 13 with the aggregate returns for the two portfolios and
the
ten company names in each of the two portfolios (company names are
positioned
in row 4)

If I am still not able to explain myself :-) I would gladly send a copy of
my Excel spreadsheet.


"Tom Ogilvy" wrote:

Sub ProcessAllWorksheets()
Dim arr As Variant
Dim rng As Range, rng1 As Range
Dim cell As Range
Dim j As Long
ReDim arr(1 To 405, 1 To 2) As Variant

For j = 8 To 412
Set rng = Worksheets("MAK").Cells(j, 2).Resize(3, 181)
Set rng1 = Worksheets("MKW").Cells(j, 2).Resize(3, 181)
arr(j - 7, 1) = Cells(j + 2, 2).Address
arr(j - 7, 2) = Application.Sum(rng, rng1)
Next j

QuickSort arr, 2, 1, 405, True

' the next lines allow you to check the array if you wish
' just uncomment them and it will add a sheet an place the array
'Set sh = Worksheets.Add(After:=Worksheets(Worksheets.Count) )
'Range("A1:B405").Value = arr

' 10 smallest
For i = 1 To 10
Set rng = Worksheets("Mak").Range(arr(i, 1))
rng.Interior.ColorIndex = 3
Next
' 10 largest
For i = 405 To 396 Step -1
Set rng = Worksheets("Mak").Range(arr(i, 1))
rng.Interior.ColorIndex = 5
Next i
End Sub

Sub QuickSort(SortArray, col, L, R, bAscending)
'
'Originally Posted by Jim Rech 10/20/98 Excel.Programming
'Modified to sort on first column of a two dimensional array
'Modified to handle a second dimension greater than 1 (or zero)
'Modified to do Ascending or Descending
Dim i, j, X, Y, mm


i = L
j = R
X = SortArray((L + R) / 2, col)
If bAscending Then
While (i <= j)
While (SortArray(i, col) < X And i < R)
i = i + 1
Wend
While (X < SortArray(j, col) And j L)
j = j - 1
Wend
If (i <= j) Then
For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, mm)
SortArray(i, mm) = SortArray(j, mm)
SortArray(j, mm) = Y
Next mm
i = i + 1
j = j - 1
End If
Wend
Else
While (i <= j)
While (SortArray(i, col) X And i < R)
i = i + 1
Wend
While (X SortArray(j, col) And j L)
j = j - 1
Wend
If (i <= j) Then
For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, mm)
SortArray(i, mm) = SortArray(j, mm)
SortArray(j, mm) = Y
Next mm
i = i + 1
j = j - 1
End If
Wend
End If
If (L < j) Then Call QuickSort(SortArray, col, L, j, bAscending)
If (i < R) Then Call QuickSort(SortArray, col, i, R, bAscending)
End Sub

--
Regards,
Tom Ogilvy


"The dan
ish student" wrote in
message
...
I have a rather large data set of monthly stock prices for 349 Danish
companies. So the data set is in two sheets due to the limits of 256
columns.
The data set starts in cell "B8" and goes until "FZ8" in both sheets
and
continues until row 414
I need a code which sums 3 months return across all companies starting
with
"B8" + "B9" + "B10" till "FZ8" + "FZ9" + "FZ10" and afterwards
illustrates
the ten largest and smallest 3 month returns across the two sheets by
marking
the final cell for example "B10". (optimally it would store the name of
the
companies with the relevant month in another sheet)
I need to incorporate a loop as well so the above mentioned macro
continues
with summing and illustrating the ten largest and smallest three month
returns. "B9"+"B10"+"B11" all the way to "B412"+"B413"+"B414"

Untill now i have created the following code but there are three
problems:
- I do not know how to incorporate the sum macro with the
"application.large"
- The loop doesn't work
- The code only works in the active sheet - It cannot look across the
two
sheets!

Here is the code:

Public Sub ProcessAllWorksheets()
Dim arr As Variant
Dim answer As Double
Dim totalAnswer As Double
Dim rng As Range, rng1 As Range
Dim l As Double, s As Double
Dim cell As Range

arr = Array("MAK", "MKW")
Sheets(arr).Select

For j = 1 To 9
Set rng = Range("B10").Resize(j, 181)
rng.Interior.ColorIndex = xlNone
l = Application.Large(rng, 10)
s = Application.Small(rng, 10)

For Each cell In rng
If IsNumeric(cell) And _
Not IsEmpty(cell) And cell.Text < "" Then
If cell.Value = l Then
cell.Interior.ColorIndex = 5
ElseIf cell.Value <= s Then
cell.Interior.ColorIndex = 3
End If
End If
Next
Next j
End Sub