Highest 3 consecutive points , ranked

Mantiyeah

New Member
Joined
Sep 19, 2018
Messages
8
I have a column with different location names, and another with their temperatures on different consecutive locations. Each city has a random amount of points/locations (around 40)
For example:
<code>Houston 10
Houston 11
Houston 14
coruna 20
coruna 21
coruna 25
coruna 28
vigo 30
vigo 15
vigo 23
vigo 24
</code>How can I find the hottest 3 consecutive points in a single city and get a link to know where are they positioned? For example ,something to show me that coruna 21, coruna 25, and coruna 28 is the hottest area. Or even coruna 25, coruna 28 and vigo 30, since they are consecutive rows.
We have managed to analyse the hottest cities with pivot tables, but not the worse areas for those cities, which seem like a hardest thing to do.
 
Here's one macro that does the same thing as the formula. Open a COPY of your workbook. I assume the layout is the same as post # 7, city in column A starting in row 2, value in column B, no gaps between rows. Press Alt-F11 to open the VBA editor. From the menu, select Insert > Module > and paste this code:

Rich (BB code):
Sub TopThree()
Dim sh As Worksheet, lr As Long, MyData As Variant, tots() As Double
Dim i As Long, j As Long, r As Long, MyLoc As Long, MyMax As Double

    Set sh = Sheets("Sheet22")
    lr = sh.Cells(Rows.Count, "B").End(xlUp).Row
    MyData = sh.Range("A1:B" & lr).Value
    
    ReDim tots(1 To UBound(MyData) - 2, 1 To 2)
    For i = 2 To UBound(MyData) - 2
        If MyData(i, 1) = MyData(i + 1, 1) And MyData(i, 1) = MyData(i + 2, 1) Then
            tots(i, 1) = MyData(i, 2) + MyData(i + 1, 2) + MyData(i + 2, 2)
        End If
    Next i
    
    sh.Range("D1:E1") = Array("Max Location (row)", "Sum")
    r = 2
    For i = 1 To 3
        MyLoc = 0
        MyMax = 0
        For j = 2 To UBound(MyData) - 2
            If tots(j, 2) = 0 Then
                If MyLoc = 0 Or tots(j, 1) > MyMax Then
                    MyLoc = j
                    MyMax = tots(j, 1)
                End If
            End If
        Next j
        If MyLoc = 0 Then
            MsgBox "No more valid 3 row areas"
            Exit Sub
        End If
        sh.Cells(r, "D") = MyLoc
        sh.Cells(r, "E") = MyMax
        r = r + 1
        For j = MyLoc - 2 To MyLoc + 2
            If j > 0 And j <= UBound(tots) Then tots(j, 2) = 1
        Next j
    Next i
        
End Sub
Change the values in red to match your sheet. Switch back to Excel. Press Alt-F8 to open the macro selector. Choose TopThree and click Run.

The cities must still be grouped, but the values no longer have to be integers. Let us know if this works for you.
 
Upvote 0

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Here's one macro that does the same thing as the formula. Open a COPY of your workbook. I assume the layout is the same as post # 7, city in column A starting in row 2, value in column B, no gaps between rows. Press Alt-F11 to open the VBA editor. From the menu, select Insert > Module > and paste this code:

Rich (BB code):
Sub TopThree()
Dim sh As Worksheet, lr As Long, MyData As Variant, tots() As Double
Dim i As Long, j As Long, r As Long, MyLoc As Long, MyMax As Double

    Set sh = Sheets("Sheet22")
    lr = sh.Cells(Rows.Count, "B").End(xlUp).Row
    MyData = sh.Range("A1:B" & lr).Value
    
    ReDim tots(1 To UBound(MyData) - 2, 1 To 2)
    For i = 2 To UBound(MyData) - 2
        If MyData(i, 1) = MyData(i + 1, 1) And MyData(i, 1) = MyData(i + 2, 1) Then
            tots(i, 1) = MyData(i, 2) + MyData(i + 1, 2) + MyData(i + 2, 2)
        End If
    Next i
    
    sh.Range("D1:E1") = Array("Max Location (row)", "Sum")
    r = 2
    For i = 1 To 3
        MyLoc = 0
        MyMax = 0
        For j = 2 To UBound(MyData) - 2
            If tots(j, 2) = 0 Then
                If MyLoc = 0 Or tots(j, 1) > MyMax Then
                    MyLoc = j
                    MyMax = tots(j, 1)
                End If
            End If
        Next j
        If MyLoc = 0 Then
            MsgBox "No more valid 3 row areas"
            Exit Sub
        End If
        sh.Cells(r, "D") = MyLoc
        sh.Cells(r, "E") = MyMax
        r = r + 1
        For j = MyLoc - 2 To MyLoc + 2
            If j > 0 And j <= UBound(tots) Then tots(j, 2) = 1
        Next j
    Next i
        
End Sub
Change the values in red to match your sheet. Switch back to Excel. Press Alt-F8 to open the macro selector. Choose TopThree and click Run.

The cities must still be grouped, but the values no longer have to be integers. Let us know if this works for you.
Yeah this one is working nicely .

Regarding the formula version. Using the example provided , I only get one value of 15 in the D2 cell and nothing in the others, or 15 in all of the cells if I select all of them before entering the array. Is there anything that I may be doing wrong?
 
Upvote 0
Glad the macro works. I can't duplicate your results with the formula. It is an array formula, so enter the formula in D2 only, make sure the ranges are correct, and press Control+Shift+Enter. Then copy that cell and paste to E2 and F2.
 
Upvote 0
@ Eric W

It seems that the original Array formula returns row 15 for Paris ... whereas your macro works out row 14 still for Paris ...

The other two cities are identical ...
 
Upvote 0
True, the two methods differ on how they handle ties. In case of a tie, the formula will take the range furthest down, while the macro will take the one furthest up. Depending on your list, subsequent locations could also be different, since a different range will be excluded from further consideration. In this example, only the first range was different.
 
Upvote 0
@ Eric W

Thanks for a very very interesting thread which has allowed me to learn a lot ...!!! :smile:

Cheers

James
 
Upvote 0

Forum statistics

Threads
1,224,828
Messages
6,181,210
Members
453,023
Latest member
alabaz

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top