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!
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!
I was thinking of using a LastCol Check, that checks the last column with values and offset the column by -1 to the left.
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!
Regards,
--------------------------------------------------------------------------------------------------------
Shrivallabha
--------------------------------------------------------------------------------------------------------
Using Excel 2016 in Home / 2010 in Office
--------------------------------------------------------------------------------------------------------
Use conditional formatting with a formula of
=COUNTIF(A$1:A1,">"&A1)
for ascending numbers,
=COUNTIF(E$1:E1,"<"&E1)
for descending numbers
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
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.
Regards,
--------------------------------------------------------------------------------------------------------
Shrivallabha
--------------------------------------------------------------------------------------------------------
Using Excel 2016 in Home / 2010 in Office
--------------------------------------------------------------------------------------------------------
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.
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
Thanks for the help, but the loop isn't looping correctly.