Solved: Finding local maximums in same cells on many sheets

[chrisweirman]

Hi,
this is my first post. It's been many years since I wrote an extensive vb program in excel and it's all gone I'm afraid. I stil remember more than the basics of programming but I need help with this one I'm afraid...

I've got a workbook of some 26 sheets, the first is where I want the collected data to come to, the next 25 contain information that looks like a mountain range when plotted as a surface map.

What I want a macro to do is to find all the local maximums on the 25 sheets (i.e. the peaks of the mountains), copy the value and the location to each peak to the first page where I can see is the 'mountains' are growing or reducing per sheet.

I have tried a nested for next loop with the first loop being counted 0 to 24, as I've named the 'mountain' sheets 0 to 24, the next loops were row and column counters. To find a local maximum I was checking the cell to the immediate right and immediate down from the active cell (providing it was +ve) to see if it was higher than both, expecting that if I looped accross then down I would find a maximum. My code is rubbish so I wont post it here but can if you want to see my start.

Cheers
Chris

[Bob Phillips]

Reduce the loops

[vba]

With Worksheets("Master")

For i = 0 To 24

.Cells(2, i + 1).Value = Application.Max(Worksheets(i).Cells)
Next i
End With
[/vba]

[chrisweirman]

if i'm correct will application.max only return the single maximum value of the cells in the range, as the max() formula within excel? what I need to find is the value and position of each maximum in a specific range on sheets "0" to "24". a local maximum given as a positive value surrounded by other positive values of less value than it (in the neighbouring 8 cells), argh! There is a very, very tedious way of doing this manually, and I've many 'scans' (doing a materials doctorate) and many samples...

[chrisweirman]

my rather poor effort is;

Sub get_residuals()
Dim anodecount As Integer
Dim outputcell_row As Integer
Dim outputcell_column As Integer
Dim scan As Integer
Dim row As Integer
Dim column As Integer
Dim curcell As Long
Dim curcell_right As Long
Dim curcell_down As Long
outputcell_row = 10
outputcell_column = 0
For scan = 1 To 25
Worksheets(scan).Activate
For row = 6 To 91

For column = 1 To 45

Set curcell = Worksheets(scan).Cells(row, column)
Set curcell_right = Worksheets(scan).Cells((row + 1), column).Value
Set curcell_down = Worksheets(scan).Cells(row, (column + 1)).Value
If curcell.Value > 0 Then
If curcell.Value > curcell_right.Value Then
If curcell.Value > curcell_down.Value Then
Worksheets("residuals").Cells(outputcell_row, outputcell_column).Value = anodecount
outputcell_column = outputcell_column + 1
Worksheets("residuals").Cells(outputcell_row, outputcell_column).Value = curcell
outputcell_column = outputcell_column + 1
Worksheets("residuals").Cells(outputcell_row, outputcell_column).Value = column
outputcell_column = outputcell_column + 1
Worksheets("residuals").Cells(outputcell_row, outputcell_column).Value = row
outputcell_column = outputcell_column + 1
Else: End If
Else: End If
Else: End If
outputcell_row = outputcell_row + 1
anodecount = anodecount + 1
Next column

Next row
outputcell_row = 10
'Next scan
End Sub

I'm still working on this but awaiting a VBA Programming book through the door and struggling with the help program until then...

[Bob Phillips]

if i'm correct will application.max only return the single maximum value of the cells in the range, as the max() formula within excel? what I need to find is the value and position of each maximum in a specific range on sheets "0" to "24". a local maximum given as a positive value surrounded by other positive values of less value than it (in the neighbouring 8 cells), argh! There is a very, very tedious way of doing this manually, and I've many 'scans' (doing a materials doctorate) and many samples...

Then use the exact range rather than the whole sheet (Cells).

As to lesser values, use LARGE(rng,2) etc.

[chrisweirman]

yeah, the range is about 85 rows by 45 columns, as per my loop size to reference the cells, but if I find the highest 2 values all I'll get is the highest 'mountain' peak and it's neighbour, local maximums, say 1.5 surrounded by values around 0.8 for instance will not be detected. If I loop a range of 9 cells to find the maximum I may get a maximum on the edge which isn't really a maximum if compared to the next cells not in the range. Does that make sense?

[Bob Phillips]

Try this, see if it gets you started

[vba]

Sub get_residuals()
Dim scan As Integer
Dim output_row As Long
Dim output_col As Long
Dim i As Long

With Worksheets("residuals")

For scan = 1 To 25

output_row = 10
output_col = 1
For i = 6 To 91

.Cells(output_row, output_col) = scan
.Cells(output_row, output_col + 1).Value = _
Application.Large(Worksheets(scan).Cells(i, "A").Resize(, 45), 1)
.Cells(output_row, output_col + 2).Value = _
Application.Large(Worksheets(scan).Cells(i, "A").Resize(, 45), 2)
output_col = output_col + 4
Next i

output_row = output_row + 1
Next scan
End With
End Sub
[/vba]

[IkEcht]

So basicly you want to step through your data 9 cells at a time (3 times 3 matrix) and if the middle cel has the highest value, report that cell?

I don't have the time right now to write a piece of code doing this, but that shouldn't be too hard (on first sight, and yes that can be so deceiving).

[chrisweirman]

yes, basically and I need to report the cell value and location to a different sheet, for every scan worksheet.

i've tried the code above and it returns an error box with 400 in it...

[Bob Phillips]

Post your worbook, let's stop guessing.

[chrisweirman]

hi, thanks. the full file is too big to be uploaded, I've cut down the number of scans to 12 (0 through 11 - these are hours hence 0 to 24)

i've included my lengthy simple code too, though this is giving me a type mismatch for some reason, working on it...

i've tried 3 times already and it won't upload...

[chrisweirman]

okay a non-compatability macro enabled file has uploaded ok. and the full file...

[IkEcht]

Okay this is no beauty but should work I guess.

[VBA]Sub findmax()
Dim c As Range
Dim i As Long
Dim shtcnt As Long

i = 10
For shtcnt = 0 To 24
For Each c In Worksheets(shtcnt).Range("a6:as91")
If c.Value > c.Offset(-1, -1).Value And c.Value > c.Offset(-1, 0).Value And c.Value > c.Offset(-1, 1).Value And c.Value > c.Offset(0, -1).Value And c.Value > c.Offset(0, 1).Value And c.Value > c.Offset(1, -1).Value And c.Value > c.Offset(1, 0).Value And c.Value > c.Offset(1, 1).Value Then
Worksheets("Residuals").Range("a" & i) = shtcnt
Worksheets("Residuals").Range("b" & i) = c.Value
Worksheets("Residuals").Range("c" & i) = c.Row
Worksheets("Residuals").Range("d" & i) = c.Column
i = i + 1
End If
Next c
Next shtcnt

End Sub[/VBA]

Didn't have time to do something with the a-column that doesn't get tested right now, as that would get tested against a non-existing rows.

More elegant solutions must be available, but I believe this does the trick.

[chrisweirman]

Getting a subscript out of range error with this code.

[Bob Phillips]

There is no worksheet 0.

Can you talk us through a set of results as per sheet 1 say?

[chrisweirman]

Hi, my code is ;

Sub my_residuals()
Dim anodecount As Long
Dim outputcell_row As Long
Dim outputcell_column As Long
Dim scan As Integer
Dim row As Integer
Dim column As Integer
Dim curcell As Long
outputcell_row = 10
outputcell_column = 0
For Each s In ActiveWorkbook.Sheets
s.Activate
If ActiveSheet.Name <> "residuals" Then
anodecount = 0
For row = 6 To 91

For column = 1 To 45
ActiveSheet.Cells(row, column).Select
curcell = ActiveCell.Value
MsgBox ("Current column val =" & column & ". Current row = " & row & ". Current cell val = " & curcell & ".")
If curcell > 0 And curcell > ActiveCell.Offset(0, -1).Value And curcell > ActiveCell.Offset(0, 1).Value And curcell > ActiveCell.Offset(-1, 0).Value And curcell > ActiveCell.Offset(1, 0).Value Then
Worksheets("residuals").Cells(outputcell_row, outputcell_column).Value = anodecount
anodecount = anodecount + 1
outputcell_column = outputcell_column + 1
Worksheets("residuals").Cells(outputcell_row, outputcell_column).Value = curcell outputcell_column = outputcell_column + 1
Worksheets("residuals").Cells(outputcell_row, outputcell_column).Value = column
outputcell_column = outputcell_column + 1
Worksheets("residuals").Cells(outputcell_row, outputcell_column).Value = row
outputcell_column = 1
outputcell_row = outputcell_row + 1
Else: End If


Next column

Next row
outputcell_row = 10
Else: End If

Next s
End Sub

And it's getting to the first scan page (sheet "0") and the correct starting cell, and it's showing the mesage box saying the cell value but then it stops giving a message box with 400 writen in it. I have had it working through cells but not finding anything with an earlier version...

[chrisweirman]

okay, the first few peaks I would expect from sheet 1 would be;

Cell N21 value 0.13
Q32 value 0.55
R39 value 0.87
R41 value 0.53

and so on. Changing Ikecht's code above to 1 to 24 gives eror code 400 too.

[chrisweirman]

i've tweaked my program a little and found that with the data in column 1 the offset trying to reference column 0 stops it. my code with a +1 to the column loop values runs but stops after at least 200 runs at cell h12 on sheet 0, which is the second peak that should be reported, peak AA9 is missed.

[chrisweirman]

success, i followed the same problem that I found with my code for Ikecht's and it worked. Thanks ever so much, I can now fiddle with the output locations from the macro and get it how i want it. Love it!

[chrisweirman]

Is it possible when working with this this range forthe code to output a cell reference as text e.g."R36" in stead of row and column reference numbers?