Rising / falling points Macro Help

[joecrabtree]

To all,

I have a list of numbers in column A on sheet1. i.e.


1
2
3
4
5
6
7
8
9
10
2
3
4
5
6


etc....

I am trying to write a macro that will identify 8 consecutive cells
that are increasing in values, or 8 consecutive cells that are
decreasing in value, and then highlight these 8 cells. So for example
in the example list it would highlight 1, 2, 3, 4, 5,6 7, 8, and
2,3,4,5,6,7,8,9, and 3,4,5,6,7,8,9,10 etc.

ANy help would be much appreciated,

Kind Regards

Joseph Crabtree

 

[somethinglikeant]

Sub UpDown8()
[A2].Select: a = 0: b = 0
Do Until IsEmpty(ActiveCell.Offset(-1, 0))
x1 = ActiveCell.Offset(-1, 0)
x2 = ActiveCell.Value
If x2 > x1 Then
a = a + 1
Else
a = 0
End If
If x2 < x1 Then
b = b + 1
Else
b = 0
End If
If a >= 7 Or b >= 7 Then
Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row - 7, 2)) = "X"
MsgBox "8 in a Row"
Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row - 7, 2)) = ""
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub

http://www.excel-ant.co.uk

 

[paul.robinson]

Hi
Try this
Sub FindChain(StartCell As Range, SearchRange As Range, ChainLength As
Integer, Increasing As Boolean)
Dim GoodRange As Boolean
Dim ChainRange As Range
Dim i As Integer
With StartCell
Set ChainRange = Intersect(Range(.Offset(0, 0), .Offset(ChainLength -
1, 0)), SearchRange)
End With
If ChainRange Is Nothing Then
MsgBox "oops!"
ElseIf ChainRange.Count < ChainLength Then
MsgBox "oops, not long enough!"
Else
ChainValues = ChainRange.Value '8 by 1 array
GoodRange = True
If Increasing = True Then
For i = 2 To ChainLength
If ChainValues(i, 1) <= ChainValues(i - 1, 1) Then
GoodRange = False
End If
If GoodRange = False Then Exit Sub
Next i
ElseIf Increasing = False Then
For i = 2 To ChainLength
If ChainValues(i, 1) >= ChainValues(i - 1, 1) Then
GoodRange = False
End If
If GoodRange = False Then Exit Sub
Next i
End If
If GoodRange = True Then ChainRange.Select
MsgBox "Good!"
End If
End Sub

Sub Tester()
Dim Cell As Range
For Each Cell In Range("A1:A20")
FindChain Cell, Range("A1:A20"), 4, True
Next Cell
End Sub

The Tester sub uses a chain length of 4 on the data in A1 to A20

1
2
3
5
6
5
2
3
7
9
10
3
11
3
4
5
7
7
6
2

regards
Paul

 

[Jon Peltier]

Formula based approach provided in thread in the charting group.

- Jon