PDA

View Full Version : Solved: Finding local maximums in same cells on many sheets



chrisweirman
03-04-2009, 06:20 AM
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
03-04-2009, 06:24 AM
Reduce the loops



With Worksheets("Master")

For i = 0 To 24

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

chrisweirman
03-04-2009, 06:33 AM
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
03-04-2009, 06:34 AM
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
03-04-2009, 06:44 AM
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
03-04-2009, 06:53 AM
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
03-04-2009, 07:05 AM
Try this, see if it gets you started



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

IkEcht
03-04-2009, 07:06 AM
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
03-04-2009, 07:27 AM
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
03-04-2009, 07:40 AM
Post your worbook, let's stop guessing.

chrisweirman
03-04-2009, 08:13 AM
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
03-04-2009, 08:20 AM
okay a non-compatability macro enabled file has uploaded ok. and the full file...

IkEcht
03-04-2009, 08:53 AM
Okay this is no beauty but should work I guess.

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

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
03-04-2009, 09:32 AM
Getting a subscript out of range error with this code.

Bob Phillips
03-04-2009, 09:38 AM
There is no worksheet 0.

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

chrisweirman
03-04-2009, 09:53 AM
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
03-04-2009, 09:58 AM
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
03-04-2009, 10:11 AM
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
03-04-2009, 10:14 AM
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
03-04-2009, 10:31 AM
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?

chrisweirman
03-04-2009, 10:37 AM
okay, just found this in excel. I think I'm done, many, many thanks all.

mdmackillop
03-04-2009, 05:29 PM
You can get an address by using say Cells(36,"R").Address(0,0)