ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Rising / falling points Macro Help (https://www.excelbanter.com/excel-programming/378698-rising-falling-points-macro-help.html)

joecrabtree

Rising / falling points Macro Help
 
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

Rising / falling points Macro Help
 
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


[email protected]

Rising / falling points Macro Help
 
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

joecrabtree wrote:

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



Jon Peltier

Rising / falling points Macro Help
 
Formula based approach provided in thread in the charting group.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutions
http://PeltierTech.com
_______


"joecrabtree" wrote in message
ups.com...
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





All times are GMT +1. The time now is 06:27 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com