Solved: Make sure numbers are increasing

[InitialD]

Yup! That does it for Column A.

If you are confused or have any questions about the code that I want from the picture posted, please let me know.

Thanks a lot!

[InitialD]

I was thinking of using a LastCol Check, that checks the last column with values and offset the column by -1 to the left.

[shrivallabha]

Hi, following is a lazy way of editing code. I have used offset property and Kenneth Hobs' trick for finding last column. See if it loops satisfactorily.
[VBA]Sub OddManOut()
Dim TopRow As Long, LastRow As Long, lLastCol As Long
Dim CurrVal As Integer, NextVal As Integer
'Find the right most filled column
lLastCol = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
For k = 0 To lLastCol - 1
'Find Top Most Filled Row
If Range("A1").Offset(, k).Value = "" Then
TopRow = Range("A1").Offset(, k).End(xlDown).Row
Else
TopRow = 1
End If
'Find Bottom Most Filled Row
LastRow = Range("A" & Rows.Count).Offset(, k).End(xlUp).Row
'Working out pattern
For i = TopRow To LastRow
If Range("A" & i + 1).Offset(, k).Value <> "" Then
CurrVal = Range("A" & i).Offset(, k).Value
NextVal = Range("A" & i + 1).Offset(, k).Value
If CurrVal = NextVal Then
'Do Nothing
ElseIf CurrVal > NextVal Then
Pattern = "Decreasing"
TopRow = i
Exit For
Else
Pattern = "Increasing"
TopRow = i
Exit For
End If
Else
CurrVal = Range("A" & i).Offset(, k).Value
If i = LastRow Then Exit Sub
i = Range("A" & i).Offset(, k).End(xlDown).Row
NextVal = Range("A" & i).Offset(, k).Value
If CurrVal = NextVal Then
'Do Nothing
ElseIf CurrVal > NextVal Then
Pattern = "Decreasing"
TopRow = i
Exit For
Else
Pattern = "Increasing"
TopRow = i
Exit For
End If
End If
Next i
For i = TopRow To LastRow
Select Case Pattern
Case "Increasing"
If Range("A" & i + 1).Offset(, k).Value <> "" Then
CurrVal = Range("A" & i).Offset(, k).Value
NextVal = Range("A" & i + 1).Offset(, k).Value
If CurrVal > NextVal Then
Range("A" & i + 1).Offset(, k).Font.Color = vbRed
'Exit Sub
ElseIf CurrVal = NextVal Then
'Do Nothing
End If
Else
CurrVal = Range("A" & i).Offset(, k).Value
i = Range("A" & i).End(xlDown).Row
If i = LastRow Then Exit Sub
NextVal = Range("A" & i).Offset(, k).Value
If CurrVal > NextVal Then
Range("A" & i).Offset(, k).Font.Color = vbRed
'Exit Sub
ElseIf CurrVal = NextVal Then
'Do Nothing
End If
i = i - 1
End If
Case "Decreasing"
If Range("A" & i + 1).Offset(, k).Value <> "" Then
CurrVal = Range("A" & i).Offset(, k).Value
NextVal = Range("A" & i + 1).Offset(, k).Value
If CurrVal < NextVal Then
Range("A" & i + 1).Offset(, k).Font.Color = vbRed
'Exit Sub
ElseIf CurrVal = NextVal Then
'Do Nothing
End If
Else
CurrVal = Range("A" & i).Offset(, k).Value
i = Range("A" & i).Offset(, k).End(xlDown).Row
If i = LastRow Then Exit Sub
NextVal = Range("A" & i).Offset(, k).Value
If CurrVal < NextVal Then
Range("A" & i).Offset(, k).Font.Color = vbRed
'Exit Sub
ElseIf CurrVal = NextVal Then
'Do Nothing
End If
i = i - 1
End If

End Select
Next i
Next k
End Sub
[/VBA]
Sorry for late reply!

[Bob Phillips]

Use conditional formatting with a formula of

=COUNTIF(A$1:A1,">"&A1)

for ascending numbers,

=COUNTIF(E$1:E1,"<"&E1)

for descending numbers

[shrivallabha]

Thats amazing! Bob, probably silly thing to ask (since invariably I've got the advice I needed on this forum), I'd like to learn the art of conditional formatting.

[Bob Phillips]

The art of CF Shrivallabha is being able to construct the formula that does what you want. This one is relatively simple, I gave a much more complex one yesterday to lukecj where he wanted to colour alternate blocks, but each 'block' only had its block id on the first row.

[InitialD]

Thanks for the help, but the loop isn't looping correctly.