Solved: Excel - Change font color if invoice number is out of order.

[frank_m]

I have a similar need to the one posted here: http://www.vbaexpress.com/forum/showthread.php?t=35949

In (Column B) I have invoice numbers that should be decreasing as you work your way down the column

example:
26939
26938
26937

When a new recorded is inserted, I need the code to scan the column to make sure that the invoice number used is larger than any of the number's below it.

Some of the numbers have a -1, or -2 at the end, so I need the code to consider the value of 26938-1 to be a larger number than 26938, but smaller than 26938-2

An example of the numbers sorted in the correct order
26940
26939
26938-2
26938-1
26938
26937
26936

example of incorrect sorting and the font highlighting that I want
26940
26939
26938-2
26938
26938-1<- New row inserted here. (after the scan it is highlighted because it is out of order)
26937
26936

If I format the cells as text, I think I can get them sorted correctly, but I have reasons that I do not want to take that approach.

In order to make the scan fast, I only need to scan 1,000 rows beginning at row 2 (all the invoice numbers are in Column B)

Thanks

[mancubus]

i think this is your case.

http://www.vbforums.com/showthread.php?t=621167

[frank_m]

Hi mancubus,

Yeah, that does indeed accomplish the out of order issue using sorting, but because I don't want to sort after each insertion, I want the font highlighting to draw attention to it.

I would take the approach of detecting when a row is inserted, and then use the change event to fill in the number based on the number below it, but unfortunately some times the user bypasses my methods by using design mode to insert the record, thereby disabling events.

[shrivallabha]

This is blind sledgehammer as it checks in one direction (down) and not tested extensively. See below:
Sub CheckWrongInvoice()
Dim lLastRow As Long, lLength As Long, lValue As Long
Dim lMainValue As Long
Dim vLastChar As Variant
lLastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lLastRow
lLength = Len(Range("A" & i).Value)
Select Case lLength
Case 5
For j = i + 1 To lLastRow
'VBA was not allowing the direct expression
lValue = Left(Range("A" & j).Value, 5)
If Range("A" & i).Value < lValue Then
MsgBox Left(Range("A" & j).Value, 5)
Range("A" & i).Interior.Color = vbRed
End If
Next j
Case Else
For j = i + 1 To lLastRow
'VBA was not allowing the direct expression
lMainValue = Left(Range("A" & i).Value, 5)
lValue = Left(Range("A" & j).Value, 5)
If lMainValue < lValue Then
Range("A" & i).Interior.Color = vbRed
ElseIf lMainValue = lValue And Len(Range("A" & j).Value) > 5 Then
'Checking the serial after - (dash)
vLastChar = Split(Range("A" & i).Value, "-")
lMainValue = vLastChar(UBound(vLastChar))
vLastChar = Split(Range("A" & j).Value, "-")
lValue = vLastChar(UBound(vLastChar))
If lMainValue < lValue Then
Range("A" & i).Interior.Color = vbRed
End If
End If
Next j
End Select
Next i

[Bob Phillips]

Use conditional formatting!

[frank_m]

HI shrivallabha (http://www.vbaexpress.com/forum/member.php?u=27076), thanks for your time in writing that routine. - I have some other problems I'm working on now, but in a day or two I'll post back to describe to you in detail some issues that are resulting from running your code.

Thanks xld (http://www.vbaexpress.com/forum/member.php?u=27076), (http://www.vbaexpress.com/forum/member.php?u=27076) your suggestion is likely the most practicle and the simplist. - When I get time I'll read up on that in the Help file to determine what formula I would need.

(http://www.vbaexpress.com/forum/member.php?u=27076)

[Bob Phillips]

It's quite a complex formula because of the - in some numbers.

This seems to do it

=SUM(--(IF(ISNUMBER(FIND("-",$B$2:$B2)),--(SUBSTITUTE($B$2:$B2,"-",0)),$B$2:$B2*100)<=IF(ISNUMBER(FIND("-",B2)),--(SUBSTITUTE($B2,"-",0)),B2*100)))>1

[frank_m]

Hi Bob,

Thanks for going to the trouble of writing that formula for me. I can see what you mean about the formula being complicated.

I figured the least I should do is attempt to figure out which conditions to use when I enter it, but I've been banging my head against the wall for awhile now and am still clueless.

In the attached sample workbook I used Cell Value is equal to :think:

Edit: Pasted sample numbers below

Desired Result
23951
23950
23948
23949
23947
23946
23944
23943
23942
23941-2 <--This one I prefer colored because -1 comes before -2, but it is also without coloring if that makes this easier to accomplish.
23941
23941-1

[Bob Phillips]

You need to use Formula Is not Cell Value

[frank_m]

Very cool Bob, that works great. - I had a mental block, thinking that a formula as a condition would mean there would be a formula in the cell. - Duh, now it seems so obvious.

Thanks a million :)

[frank_m]

Hi again Bob,

I really appreciate the help.

Would it be a lot of trouble to change the formula to give me this result?
23898
23887
23896
23895
23894
23893
23892
23891
23890
23889
23888
23887
23886

I can see the logic in why the current result's are as shown below, but I hope it can be changed to be like the above example.
Being that 23887 is the only number that is out of order, it sure would make things easier for me if only that one is colored red.
(In this case that number is also duplicated. I don't think that is the issue, but I will look into it and post back if it is related.)
23898
23887
23896
23895
23894
23893
23892
23891
23890
23889
23888
23887
23886

I've attached a sample workbook.

[frank_m]

After looking into this further, I see now that it is the fact that the number is duplicated that is causing the formatting to have all the numbers between the duplicates turning red.

At a later point in time I will be using only Excel 2007, where I am nearly sure that the duplicate number's could be marked differently than the out of order, but for now, even if there are duplicates, I much prefer the formatting results to be as I described in my last post
(For now I'm fine without spotting the duplicates, if that's complicated in Excel 2003 -- Note: in any case I would only want to mark dup's, not prevent them)

(In my last post I have the duplicate's underline. That is for clarity here, not the desired format.)

Thanks

[Bob Phillips]

If you are only interested in the follwong value, you can use

=AND(B4<>"",IF(ISNUMBER(FIND("-",$B3)),--(SUBSTITUTE($B3,"-",0)),$B3*100)<=IF(ISNUMBER(FIND("-",$B4)),--(SUBSTITUTE($B4,"-",0)),$B4*100))

[frank_m]

Good day to you Bob,

Hope that by now I'm not becoming a pain in your neck.

I added that new formula as a 2nd condition and that took care of what I had complained about with the duplicates.

However, now it's coloring evering between 23886 and 23887 when there are actually only three numbers that are out of order.

23887 out of order
23903
23902-1
23902-2 out of order
23902
23900
23899
23897
23896
23895
23894
23893
23901 out of order
23892
23891
23890
23889
23888
23886

Edit: I see now that it's actually still doing the same as before with the duplicate's.

Am I implementing this incorrectly? - I tried using the new formula as the only condition, but that's not working.

Demonstration workbook attached

[frank_m]

HI again,

In the new formula, is referring to both B4 and B3 correct ?

=AND(B4<>"",IF(ISNUMBER(FIND("-",$B3)),--(SUBSTITUTE($B3,"-",0)),$B3*100)<=IF(ISNUMBER(FIND("-",$B4)),--(SUBSTITUTE($B4,"-",0)),$B4*100))

In my implementation if the cell is in Row2 I use only B2 for all 7 references

Am I missing something?

I tried the formula as given as well, but that doesn't give any logical result.

[frank_m]

I've been experimenting,,,, (I know, what a scary thought :p) and most recently tried using =COUNTIF(B:B,B2)>1 to give a different color to the duplicates.

Seems to work with very limited testing. If this does turn out to consistently work, that gives me a much easier way of spotting the reason for why seemingly in order numbers are colored red.

Most of you are probably getting a little tired of the frequency at which I decide to think out loud with a new post about this, but hope someone might give me some guidance before my whole day evaporates.

[Bob Phillips]

Frank,

I think this works with that data

=IF(ISNUMBER(--(SUBSTITUTE($B15,"-",0))),IF(ISNUMBER(FIND("-",$B16)),--(SUBSTITUTE($B16,"-",0)),$B16*100)>IF(ISNUMBER(FIND("-",$B15)),--(SUBSTITUTE($B15,"-",0)),$B15*100))

I am completely confused by what that COUNTIF formula is supposed to be doing.

[frank_m]

Hi Bob, I see that the 2nd reference in the formula is B15. Shouldn't they all be B16, presuming that row 15 is the header row Then I set conditional formatting in the B16 cell, then use the format painter to copy it down? The count is a 2nd condition. In that sample workbook that I attached before it successfully format's duplicates a different color than the 'out of order numbers'. Edited my comments above after testing the countif as a 2nd condition.

[frank_m]

I see now that the B15 reference is correct as the formula is working. Thanks a bunch for that.

I have been testing using countif as a second condition to color the duplicates blue and in bold, and it is doing as I want. At least so far it is.

The out put of more testing below has the slight bug in 23896 being colored
23902-1
23902-2
23902
23901
23900
23899
23898
23887
23896 <- Not sure if this is a result of the 1st or 2nd condition countif. I'll post back
23895
23894
23893
23892
23891
23890
23889
23888
23887
23886

Edit: Tried putting it back to using only one condition and your formula, but in the case of a duplicate the behavior is a little odd as the number 23896 is being colored (which is right below the duplicate, but otherwise in order) This result is not too bad for me though, if it only occurs next to a duplicate.

New sample workbook attached has one duplicate number

[Bob Phillips]

That second one is coloured red because that is the one that is not decreasing in the order. So it is right as far as I can see

[frank_m]

That will be ok.

from the perspective that the formula checks to make sure each number is decreasing I would guess it has to be that way.

If I use the 2nd condition that I mentioned, that colors duplicates a different color, which to my eyes makes the situation more apparent..

Thanks for checking that out for me.. As far as I can tell, I'm in great shape now, thanks once again to you masterful skill and generous sharing :friends:

[Bob Phillips]

from the perspective that the formula checks to make sure each number is decreasing I would guess it has to be that way.

I think so. If you had a rule when it was the other way that could be introduced into the formula, but I fear it would become horrendously complex.

[frank_m]

Thanks again Bob - All is good.

Just to note again:
I'm using a 2nd condition to make the red colored# occurrence's(when they are present below a duplicate), easier for my eye to brain interpretation.

After a lot of testing, the formula that I came up with for the 2nd condition is: =COUNTIF($B16:$B$316,$B16)>1

For those novice ones (like myself), I'll describe that above is how the formula looks in the conditional format dialog box when Cell B16 is selected

The 2nd condition is coloring my duplicates a different color than the 1st condition. - It checks the range between the current cell and cell B316
-- I limited the range to check to only cell 316. because I found that if I extend that much more tan 300 rows, significantly slows down my 'selection change event' macros

[Bob Phillips]

Frank,

Instead of

=COUNTIF($B16:$B$316,$B16)>1

won't

=COUNTIF($B:$B,$B16)>1

work? Excel should smartly handle the variability without affecting performance, and no need to worry about new rows appended.

[frank_m]

Aweeee, I think my idle is bailing me out once again :bow:

I just discovered that using =COUNTIF($B16:$B$316,$B16)>1 is reaking havoc with the behavior of the code that I have in my selection change event.
(makes no sense to me how a formula in a conditionally formatted cell could affect code, but I have proven with testing that it most certainly is)

I adjusted it to =COUNTIF($B16:$B316,$B16)>1 and my issue with my selection event code seems to have disappear, but your formula looks much cleaner and efficient.

I'm going to try it and will post back in a few minutes

[frank_m]

Hi Bob

Because I am using Cell B1 to reflect the value in the selected row column B cell, that cause's the formula to think every row is a duplicate immediately after it's selected.

In the formula below I changed $B$316 to $B316 to solve other issues, and so far it is testing to be good. - Of course I'm always happy to see an improved version :yes -- Thank you much for putting so much attention into this --
=COUNTIF($B16:$B316,$B16)>1

[frank_m]

Unfortunately a new problem has surfaced.

If the rows are filtered my selection change event code slows down a lot.

I tried turning off calculation at the beginning of my selection change events
Sub Calculation_Off()
Application.Calculation = xlCalculationManual
With ActiveSheet
.EnableCalculation = False
End With
End Sub and turning it back on after, but that didn't help
Sub Calculation_On()
Application.Calculation = xlCalculationAutomatic
With ActiveSheet
.EnableCalculation = True
.Calculate
End With
End Sub Same problem exist even when remove the 2nd condition formula
and only use the 1st formula you gave me as shown below
=IF(ISNUMBER(--(SUBSTITUTE($B15,"-",0))),IF(ISNUMBER(FIND("-",$B16)),--(SUBSTITUTE($B16,"-",0)),$B16*100)>IF(ISNUMBER(FIND("-",$B15)),--(SUBSTITUTE($B15,"-",0)),$B15*100))

To reiterate, when I remove all conditional formatting my selection change events fire a lot faster.

[Bob Phillips]

Can you post the workbook, I am getting confused now.

[frank_m]

As I was working away at stripping code and data and many of the sheets out of the workbook to reduce it's size so that I could post a sample, I stumbled across what was causing the issue.

Here is how the code was:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

Static TheRow As Range
Dim cll As Range
Dim Lastrow As Long

Lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

If ActiveCell.Row > 15 Then

ActiveSheet.Unprotect

Cells(10, 1).Value = Target.EntireRow.Cells(1).Value
Cells(10, 2).Value = Target.EntireRow.Cells(2).Value
Cells(10, 3).Value = Target.EntireRow.Cells(3).Value
Cells(10, 4).Value = Target.EntireRow.Cells(4).Value
Cells(10, 5).Value = Target.EntireRow.Cells(5).Value

Cells(10, 6).Value = Target.EntireRow.Cells(6).Value
Cells(10, 7).Value = Target.EntireRow.Cells(7).Value
Cells(10, 8).Value = Target.EntireRow.Cells(8).Value
Cells(10, 9).Value = Target.EntireRow.Cells(9).Value
Cells(10, 10).Value = Target.EntireRow.Cells(10).Value
Cells(10, 11).Value = Target.EntireRow.Cells(11).Value
Cells(10, 12).Value = Target.EntireRow.Cells(12).Value
Cells(10, 13).Value = Target.EntireRow.Cells(13).Value
Cells(10, 14).Value = Target.EntireRow.Cells(14).Value
Cells(10, 15).Value = Target.EntireRow.Cells(15).Value
Cells(10, 16).Value = Target.EntireRow.Cells(16).Value
Cells(10, 17).Value = Target.EntireRow.Cells(17).Value
Cells(10, 18).Value = Target.EntireRow.Cells(18).Value
Cells(10, 19).Value = Target.EntireRow.Cells(19).Value
Cells(10, 20).Value = Target.EntireRow.Cells(20).Value
Cells(10, 21).Value = Target.EntireRow.Cells(21).Value
Cells(10, 22).Value = Target.EntireRow.Cells(22).Value
Cells(10, 23).Value = Target.EntireRow.Cells(23).Value


If TheRow Is Nothing Then
With Range("A16:AD" & Lastrow)
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Else
For Each cll In TheRow.Cells
cll.Borders(xlEdgeTop).LineStyle = xlNone
cll.Borders(xlEdgeBottom).LineStyle = xlNone
Next cll
End If

If Target.Rows.Count = 1 Then

Application.ScreenUpdating = False

Set TheRow = Target.EntireRow.Resize(, 30)

With TheRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With

With TheRow.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With

TheRow.Cells(14).Borders(xlEdgeRight).LineStyle = xlNone
End If


Range("A15:AD15").Interior.ColorIndex = 15
Cells(15, Target.Column).Interior.ColorIndex = 45
Application.ScreenUpdating = True

End If

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True, userinterfaceonly:=True

End Sub In the version below you can see that I moved Application.ScreenUpdating = False farther up in the code.
I understand why it's much better there, but it makes no sense to me why the events only fire slowly when conditional formatting is used

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

Static TheRow As Range
Dim cll As Range
Dim Lastrow As Long

Lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

If ActiveCell.Row > 15 Then

Application.ScreenUpdating = False

ActiveSheet.Unprotect

Cells(10, 1).Value = Target.EntireRow.Cells(1).Value
Cells(10, 2).Value = Target.EntireRow.Cells(2).Value
Cells(10, 3).Value = Target.EntireRow.Cells(3).Value
Cells(10, 4).Value = Target.EntireRow.Cells(4).Value
Cells(10, 5).Value = Target.EntireRow.Cells(5).Value

Cells(10, 6).Value = Target.EntireRow.Cells(6).Value
Cells(10, 7).Value = Target.EntireRow.Cells(7).Value
Cells(10, 8).Value = Target.EntireRow.Cells(8).Value
Cells(10, 9).Value = Target.EntireRow.Cells(9).Value
Cells(10, 10).Value = Target.EntireRow.Cells(10).Value
Cells(10, 11).Value = Target.EntireRow.Cells(11).Value
Cells(10, 12).Value = Target.EntireRow.Cells(12).Value
Cells(10, 13).Value = Target.EntireRow.Cells(13).Value
Cells(10, 14).Value = Target.EntireRow.Cells(14).Value
Cells(10, 15).Value = Target.EntireRow.Cells(15).Value
Cells(10, 16).Value = Target.EntireRow.Cells(16).Value
Cells(10, 17).Value = Target.EntireRow.Cells(17).Value
Cells(10, 18).Value = Target.EntireRow.Cells(18).Value
Cells(10, 19).Value = Target.EntireRow.Cells(19).Value
Cells(10, 20).Value = Target.EntireRow.Cells(20).Value
Cells(10, 21).Value = Target.EntireRow.Cells(21).Value
Cells(10, 22).Value = Target.EntireRow.Cells(22).Value
Cells(10, 23).Value = Target.EntireRow.Cells(23).Value


If TheRow Is Nothing Then
With Range("A16:AD" & Lastrow)
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Else
For Each cll In TheRow.Cells
cll.Borders(xlEdgeTop).LineStyle = xlNone
cll.Borders(xlEdgeBottom).LineStyle = xlNone
Next cll
End If

If Target.Rows.Count = 1 Then

Set TheRow = Target.EntireRow.Resize(, 30)

With TheRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With

With TheRow.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With

TheRow.Cells(14).Borders(xlEdgeRight).LineStyle = xlNone
End If

Range("A15:AD15").Interior.ColorIndex = 15
Cells(15, Target.Column).Interior.ColorIndex = 45
Application.ScreenUpdating = True

End If

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True, userinterfaceonly:=True

End Sub
To make sure that I've explained correctly, ONLY with the 2nd version of code shown above, I now am able to use conditional formatting without it affecting my selection event code

If you'd like I can finish up with the stripping down the workbook, so you'll be able to see for yourself.

Thanks

[frank_m]

HI Bob,

I posted three sample workbooks over in this thread http://www.vbaexpress.com/forum/showthread.php?t=35397
(Post's #19 and 20 on page one and Post 21 on page two)

They should demonstrate the issue.

Thanks

[Bob Phillips]

I couldn't run it as when I double-clicked, the worksheet is protected.

But maybe the reason it is slow is because the code is forcing a screen repaint frequently when the ScreenUpdating is not turned off.

[frank_m]

Edit: My Button code in the attached sample workbook is working fine in my Excel 2003, but when I tried it in 2007 it freezes.
I'll post a new version after I get that figured out.
* My issues are solved by turning off screen updating and also by using 'Pascals' code to fill values in row 10.
I'm merely asking about this out of curiosity.

Hi Bob,

I've attached another sample workbook. - Now I have the button/'s doing the filtering and the (adding-or-removing of the conditional formatting)

I believe from that you'll see that when the formatting and filtering are both in place, a selection change takes several seconds.

It sure seems like a bug in Excel to me, rather than the time it takes to repaint the cells with screen updating turned of.

I realize though that I'm a laymen though :dunno