Excel - Find Max Value every 10 rows &mark row

December 2016




Issue


I need help creating a formula in excel to Identify the Highest and Lowest values Every 10 rows THEN Identify those two rows by placing some text or number in a blank column in the rows with the highest and lowest values. For example I want to return the word keep in Column A3 for ONLY the Highest and Lowest trade price for each 10 row incement. This way I can sort the data by Keep and delete the other 8 rows of data. This way I can keep most of my data integrity and greatly reduce the size of the file.

I am using Excel 2007 and I have a 160,000 rows of data. The purpose of the formula is to cut this data down to by 80%


The spreadsheet below gives a simple example.

Trade 
                Time                 Price                 C is a blank column for formula out put 
___________A____________B_____________C 
Row 1     19:30:25              121.81 

Row 2     19:30:26              121.80              Keep 

Row 3    19:30:29               121.83 

Row 4    19:30:31              121.86                  Keep 

Row 5    19:39:35              121.84 



Any help would be greatly appreciated.

Solution


There are 3 macros "test","test1" and "undo". Test1 is embedded in "test", so it is enough if you run only the macro "test".
All the three macros should be in the module. Macro "undo" undoes the macro results.
Take a small extract of your data about 31 rows and check the macro. If the results are ok you can use the macros on your original file

KEEP THE ORIGINAL FILE SAFELY SOMEWHERE SO THAT IT CAN BE RETRIEVED.

Macro 1:


Dim r As Range, r1 As Range, x As Double, y As Double
Dim j As Integer, k As Integer
Dim r2 As Range, m As Integer

Sub test()
Worksheets("sheet1").Activate
Range("c1") = "signal"
Set r2 = Range(Range("B1"), Range("B1").End(xlDown))
j = 1
m = 1
Do
Set r = Cells(j * m + 1, "B")
MsgBox r.Address
Set r1 = Range(r, r.Offset(9, 0))
MsgBox r1.Address
If r.Offset(9, 0) = "" Then Exit Do
x = WorksheetFunction.Min(r1)
y = WorksheetFunction.Max(r1)
MsgBox x
MsgBox y
k = WorksheetFunction.Match(x, r2, 0)
Cells(k, "c") = "keep"
k = WorksheetFunction.Match(y, r2, 0)
Cells(k, "c") = "keep"
m = m + 10
MsgBox m
Loop
test1
End Sub


Macro 2:

Sub test1()
Worksheets("sheet1").Activate
Set r = Range(Range("A1"), Range("A1").End(xlDown).Offset(0, 3))
r.AutoFilter field:=3, Criteria1:="keep"
r.Cells.SpecialCells(xlCellTypeVisible).Copy Worksheets("sheet2").Range("A2")

ActiveSheet.AutoFilterMode = False
End Sub


Macro 3:

Sub undo()
Worksheets("sheet1").Range("c1").EntireColumn.Delete
Worksheets("sheet2").Cells.Clear
End Sub

Note


Thanks to venkat1926 for this tip on the forum.

Related :

This document entitled « Excel - Find Max Value every 10 rows &mark row » from CCM (ccm.net) is made available under the Creative Commons license. You can copy, modify copies of this page, under the conditions stipulated by the license, as this note appears clearly.