Highlight Values in sequentially descending order without using Sort.

ExcelAlumni

New Member
Joined
Jun 19, 2020
Messages
11
Office Version
  1. 2016
Platform
  1. Windows
Hoping someone can help. Looking for a conditional formatting solution for the following.
Have a long single column of data of differing numbers high & low and want to apply cell color format to highlight only the sequentially lower numbers in order down from the top to bottom.

So for e.g. A1 (1st number) is highlighted, (eg 238,654)
then second lowest down from that, let’s say it happens to be A3 (eg 237,234) (with A2 238655 ignored.)
then 3rd lowest etc…(eg 232,077) & any higher between 237,234 and 232,077 ignored.

In this manner the numbers get lower and lower towards zero with all subsequent higher numbers between each step getting ignored.
e.g. The highlighted numbers would start high and gradually get lower.
I don’t want to simply highlight the 10 lowest numbers in a column. I want to highlight numbers in the column in descending order with each new highlighted number always lower than the last.

- I do not want to use sort data options.

Alternatively an option to copy the numbers descending as described to an adjoining column; if so in same order and row position as original column.
I do not currently have the experience to be comfortable with VBA/Macros

Thanks in advance for any help or suggestions.
 
Thanks for clarifying the reset rule, it is different from what I had gleaned from your prior posts. Please help me further by answering the following:
1. In the example data you show in Post #19, are you using Delta or Percent and what is the value for the one you are using?
2. Why is cell A79 not highlighted if A78 is the reset cell? A79 is less than A78.
Also, can you do careful manual highlighting and boldening for the data set w/o the red fill and post it using XL2BB - it's very helpful for me.

Yes Apologies again for discrepancies, all quite new to me & I was describing what I believed I wanted in post #7 & only when I saw yesterdays test results did it become clear it wasn't.
1. Yes it is 'Percent' at +2.25% of column A.
2. Yes you are right A79 should also be highlighted I will be take greater care over manual illustration - apologies for any frustrations this caused.
Please find amended version posted with XL2BB
25.6.20 eg4ii.xlsm
ABCDE
13125.4883143.163125.4883143.16
23115.5963136.563115.5963136.56
33120.8243132.2363120.8243132.236
43124.6163127.263124.6163127.26
53122.223130.5963122.223130.596
63127.3683131.4083127.3683131.408
73128.1523133.0523128.1523133.052
83128.83133.1883128.83133.188
93130.0283133.2283130.0283133.228
103130.8283135.083130.8283135.08
113129.8923138.5483129.8923138.548
123134.2883139.1723134.2883139.172
133130.8283139.3523130.8283139.352
143126.9083137.4043126.9083137.404
153126.443134.023126.443134.02
163131.40831363131.4083136
173134.0043136.8523134.0043136.852
183132.0083137.043132.0083137.04
1931323137.1431323137.14
2031323136.231323136.2
213135.43140.7283135.43140.728
223139.183144.483139.183144.48
233144.9163163.463144.9163163.46
243194.243194.24
253200.1883200.188
2632163216
273213.5363213.536
2832183218
293215.0563215.056
303204.4123204.412
3132003200
323189.7763189.776
333192.583192.58
343190.2323190.232
353186.9283186.928
363183.4483183.448
373181.9083181.908
383183.9043183.904
393185.9883185.988
403188.7963188.796
413188.3363188.336
423184.0843184.084
433187.3523187.352
443188.523188.52
453187.643187.64
463184.783184.78
473180.3923180.392
483178.9723178.972
4931783178
503180.0843180.084
513181.5323181.532
523181.423181.42
533178.3243178.324
543175.4123175.412
5531763176
563174.4763174.476
5731723172
5831723172
593170.1883170.188
603175.0643175.064
613171.343171.34
623173.183173.18
6331723172
643172.4043172.404
653166.9363166.936
663169.0923169.092
673170.1523170.152
6831723172
6931723172
7031723172
7131723172
723173.1963173.196
733174.0443174.044
743174.7443174.744
753174.2163174.216
763171.4283171.428
773171.1923171.192
783165.1843169.743165.1843169.74
793164.00431703164.0043170
803164.7043169.543164.7043169.54
813167.2763175.2123167.2763175.212
823175.1963177.5643175.1963177.564
833176.6231843176.623184
843176.943185.7363176.943185.736
853183.2083189.7843183.2083189.784
863183.23189.4483183.23189.448
873177.7323188.13177.7323188.1
883176.4963184.0163176.4963184.016
893172.6323182.5163172.6323182.516
9031723181.9631723181.96
913172.1243179.7163172.1243179.716
923168.83177.9243168.83177.924
933169.6563174.43169.6563174.4
943168.83174.7483168.83174.748
953172.663174.43172.663174.4
963173.9523177.8723173.9523177.872
973174.43177.6123174.43177.612
983174.0123177.6083174.0123177.608
993154.9643177.8163154.9643177.816
1003144.43176.4323144.43176.432
1013142.6923158.93142.6923158.9
1023149.3043156.1923149.3043156.192
1033150.4123159.1963150.4123159.196
1043158.2323160.43158.2323160.4
1053157.2683162.5043157.2683162.504
1063150.0083161.5283150.0083161.528
1073158.0283165.4883158.0283165.488
10831643171.93631643171.936
1093168.0683172.6283168.0683172.628
1103168.4243173.523168.4243173.52
1113168.2243178.543168.2243178.54
1123177.23194.5243177.23194.524
1133187.3683196.1763187.3683196.176
1143183.163204.83183.163204.8
1153180.8483188.9163180.8483188.916
1163175.8083187.7523175.8083187.752
1173174.4123182.6723174.4123182.672
1183176.923181.583176.923181.58
11931783181.20431783181.204
1203172.723184.2923172.723184.292
1213173.0563181.33173.0563181.3
1223177.1283182.0643177.1283182.064
1233176.6683183.83176.6683183.8
1243177.5723183.6043177.5723183.604
1253175.2963181.63175.2963181.6
1263174.2523181.3363174.2523181.336
1273175.063181.3643175.063181.364
1283178.363181.7723178.363181.772
1293179.1163184.43179.1163184.4
1303183.5523189.5483183.5523189.548
1313182.8123190.7443182.8123190.744
1323189.223196.4523189.223196.452
13331883198.07631883198.076
1343182.6763197.6563182.6763197.656
1353183.1483190.8883183.1483190.888
1363190.3043197.6283190.3043197.628
1373189.3883201.23189.3883201.2
1383193.563204.6963193.563204.696
1393191.28832083191.2883208
14031863206.00831863206.008
1413189.223195.383189.223195.38
1423180.43197.5283180.43197.528
1433180.8163194.2363180.8163194.236
1443182.643189.5443182.643189.544
1453185.2083188.523185.2083188.52
1463182.7163191.1163182.7163191.116
1473189.483194.2763189.483194.276
1483192.2123196.063192.2123196.06
1493187.1843196.1243187.1843196.124
1503183.23197.2243183.23197.224
1513184.0243189.13184.0243189.1
1523183.3283187.9843183.3283187.984
15331783186.77231783186.772
1543179.53187.1763179.53187.176
1553185.23188.9243185.23188.924
1563186.823194.1963186.823194.196
1573192.2283197.4483192.2283197.448
1583190.71631963190.7163196
1593183.2043194.423183.2043194.42
16031843193.5231843193.52
1613180.4283191.263180.4283191.26
1623163.963187.1643163.963187.164
1633170.4123180.783170.4123180.78
1643173.2363181.6043173.2363181.604
1653180.3323191.23180.3323191.2
1663188.8283194.6443188.8283194.644
1673188.432023188.43202
16831863201.45631863201.456
1693187.1323197.0883187.1323197.088
1703188.0843195.9563188.0843195.956
17131903196.89231903196.892
1723190.6843201.2523190.6843201.252
1733201.263253.4523201.263253.452
Sheet1

And if I'm not sounding like a broken record. Much appreciation for your perseverance on this.
 
Upvote 0

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Thanks for the clarifications. Here's another revision. It agrees with your cols D&E expected results from post #21. I have not tested beyond that. Maybe you can test it further and let me know the outcome.
VBA Code:
Sub HiliteValuesDescending6()
Const Delta As Double = 10  'the amount by which col B must exceed col A to bolden col B entry
Const Percent As Double = 1.0225 ' Col B must exceed col A by (Percent x col A) to bolden col B entry
Dim Ra As Range, Va As Variant, Rb As Range, Vb As Variant, i As Long, j As Long, Mn As Variant
Dim Rfill As Range, Rbold As Range, Ans As String, Begin As Long
Ans = InputBox("Which constant do you want to use: Delta or Percent?")
If Ans = "" Then Exit Sub
If Ans <> "Delta" And Ans <> "Percent" Then
    MsgBox "You must enter either Delta or Percent - try again."
    Exit Sub
End If
Set Ra = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set Rb = Range("B1:B" & Cells(Rows.Count, "A").End(xlUp).Row)
Va = Ra.Value: Vb = Rb.Value
Set Rfill = Range("A1")
Mn = Rfill.Value
If Vb(1, 1) >= IIf(Ans = "Delta", Mn + Delta, Percent * Mn) Then
    Set Rbold = Range("B1")
    If Not IsEmpty(Va(2, 1)) Then
        Set Rfill = Union(Rfill, Ra(2))
        Mn = Va(2, 1)
    Else
        For j = 3 To UBound(Va, 1)
            If Not IsEmpty(Va(j, 1)) Then
                Mn = Va(j, 1)
                Set Rfill = Union(Rfill, Ra(j))
                Begin = j
                j = 0
                Exit For
            End If
        Next j
    End If
End If
For i = Application.Max(LBound(Va, 1) + 1, Begin) To UBound(Va, 1) - 1
    If i < Begin Then i = Begin
    If Not IsEmpty(Va(i, 1)) Then
        If Va(i, 1) < Mn Then
            Mn = Va(i, 1)
            Set Rfill = Union(Rfill, Ra(i))
        End If
    End If
    If Vb(i, 1) >= IIf(Ans = "Delta", Mn + Delta, Percent * Mn) Then
        If Rbold Is Nothing Then
            Set Rbold = Rb(i)
        Else
            Set Rbold = Union(Rbold, Rb(i))
        End If
        If Not IsEmpty(Va(i + 1, 1)) Then
            Set Rfill = Union(Rfill, Ra(i + 1))
            Mn = Va(i + 1, 1)
        Else
            For j = i + 1 To UBound(Va, 1)
                If Not IsEmpty(Va(j, 1)) Then
                    Mn = Va(j, 1)
                    Set Rfill = Union(Rfill, Ra(j))
                    Begin = j
                    j = 0
                    Exit For
                End If
            Next j
        End If
    End If
Next i
If Va(UBound(Va, 1), 1) < Mn Then
    Set Rfill = Union(Rfill, Ra(UBound(Va, 1)))
    Mn = Va(UBound(Va, 1), 1)
End If
If Vb(UBound(Va, 1), 1) >= IIf(Ans = "Delta", Mn + Delta, Percent * Mn) Then Rb(UBound(Va, 1)).Font.Bold = True
Application.ScreenUpdating = False
If Not Rfill Is Nothing Then Rfill.Interior.Color = vbYellow
If Not Rbold Is Nothing Then Rbold.Font.Bold = True
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hey Hey JoeMo,
Thanks so much with all your kindness, & help with this project.
Not only does that code now work perfectly for my needs, I can adapt it to many other uses.

I've also implemented following vba code so I can count & compare relevant conditions too.
Function CountOnlyNumbersBold(myRange As Range)

For Each myCell In myRange
If myCell.Font.Bold Then
myCount = myCount + 1
End If
Next

CountOnlyNumbersBold = myCount

End Function

On top of all that you have given me a taster for VBA & I will now dedicate time in the future to learning the ropes.
Do you recommend any novice tips & lessons along the way.
I've found this as a positive starting point.

One problem I've run into already is the Alt+F11 etc commands do not seem to work for me on my PC running windows 8.
I've tried all the tips recommend on this post it does seem my f.lux brightness F11 controls are over-riding.
I've disable hotkeys but the keys are still operational ??
I believe changing via Bios would only give me same options.

Anyway not too important. Thanks so much for inspiring a new VBA convert.
 
Upvote 0
Hey Hey JoeMo,
Thanks so much with all your kindness, & help with this project.
Not only does that code now work perfectly for my needs, I can adapt it to many other uses.


On top of all that you have given me a taster for VBA & I will now dedicate time in the future to learning the ropes.
Do you recommend any novice tips & lessons along the way.
I've found this as a positive starting point.

One problem I've run into already is the Alt+F11 etc commands do not seem to work for me on my PC running windows 8.
I've tried all the tips recommend on this post it does seem my f.lux brightness F11 controls are over-riding.
I've disable hotkeys but the keys are still operational ??
I believe changing via Bios would only give me same options.

Anyway not too important. Thanks so much for inspiring a new VBA convert.
You are welcome. Glad you were willing to move out of your comfort zone and become a convert.

I did some additional testing of the latest code I posted in post #22 and found a runtime error in the event the next to last data cell in col A is empty. Here's a revision (one line added) that handles that case. Please replace the existing code with this rev. 7.
VBA Code:
Sub HiliteValuesDescending7()
Const Delta As Double = 10  'the amount by which col B must exceed col A to bolden col B entry
Const Percent As Double = 1.0225 ' Col B must exceed col A by (Percent x col A) to bolden col B entry
Dim Ra As Range, Va As Variant, Rb As Range, Vb As Variant, i As Long, j As Long, Mn As Variant
Dim Rfill As Range, Rbold As Range, Ans As String, Begin As Long
Ans = InputBox("Which constant do you want to use: Delta or Percent?")
If Ans = "" Then Exit Sub
If Ans <> "Delta" And Ans <> "Percent" Then
    MsgBox "You must enter either Delta or Percent - try again."
    Exit Sub
End If
Set Ra = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set Rb = Range("B1:B" & Cells(Rows.Count, "A").End(xlUp).Row)
Va = Ra.Value: Vb = Rb.Value
Set Rfill = Range("A1")
Mn = Rfill.Value
If Vb(1, 1) >= IIf(Ans = "Delta", Mn + Delta, Percent * Mn) Then
    Set Rbold = Range("B1")
    If Not IsEmpty(Va(2, 1)) Then
        Set Rfill = Union(Rfill, Ra(2))
        Mn = Va(2, 1)
    Else
        For j = 3 To UBound(Va, 1)
            If Not IsEmpty(Va(j, 1)) Then
                Mn = Va(j, 1)
                Set Rfill = Union(Rfill, Ra(j))
                Begin = j
                j = 0
                Exit For
            End If
        Next j
    End If
End If
For i = Application.Max(LBound(Va, 1) + 1, Begin) To UBound(Va, 1) - 1
    If i < Begin Then i = Begin
    If Not IsEmpty(Va(i, 1)) Then
        If Va(i, 1) < Mn Then
            Mn = Va(i, 1)
            Set Rfill = Union(Rfill, Ra(i))
        End If
    End If
    If Vb(i, 1) >= IIf(Ans = "Delta", Mn + Delta, Percent * Mn) Then
        If Rbold Is Nothing Then
            Set Rbold = Rb(i)
        Else
            Set Rbold = Union(Rbold, Rb(i))
        End If
        If i = UBound(Va, 1) Then GoTo Nx
        If Not IsEmpty(Va(i + 1, 1)) Then
            Set Rfill = Union(Rfill, Ra(i + 1))
            Mn = Va(i + 1, 1)
        Else
            For j = i + 1 To UBound(Va, 1)
                If Not IsEmpty(Va(j, 1)) Then
                    Mn = Va(j, 1)
                    Set Rfill = Union(Rfill, Ra(j))
                    Begin = j
                    j = 0
                    Exit For
                End If
            Next j
        End If
    End If
Next i
Nx: If Va(UBound(Va, 1), 1) < Mn Then
        Set Rfill = Union(Rfill, Ra(UBound(Va, 1)))
        Mn = Va(UBound(Va, 1), 1)
    End If
Application.ScreenUpdating = False
If Vb(UBound(Va, 1), 1) >= IIf(Ans = "Delta", Mn + Delta, Percent * Mn) Then Rb(UBound(Va, 1)).Font.Bold = True
If Not Rfill Is Nothing Then Rfill.Interior.Color = vbYellow
If Not Rbold Is Nothing Then Rbold.Font.Bold = True
Application.ScreenUpdating = True
End Sub
As for tips & lessons, there's a huge volume of free material you can access via the web. And one of the best ways I found to learn, and continue learning, is to spend time on the MrExcel forum.

Afraid I can't help you with the shortcut keys issue. I have not seen that problem using Windows XP, Vista, Win7 or Win10.
 
Upvote 0
I did some additional testing of the latest code I posted in post #22 and found a runtime error in the event the next to last data cell in col A is empty. Here's a revision (one line added) that handles that case. Please replace the existing code with this rev. 7.

Wow thanks again JoeMo, for your conscientious diligence to the code, hugely appreciated. I'll definitely be spending more future hours on the forum picking up lessons, tips & tricks.

Afraid I can't help you with the shortcut keys issue. I have not seen that problem using Windows XP, Vista, Win7 or Win10.
Fair enough, one thought, is there a way of modifying / changing the standard Function key shortcuts via VBA....?

Chat Soon.
 
Upvote 0
Wow thanks again JoeMo, for your conscientious diligence to the code, hugely appreciated. I'll definitely be spending more future hours on the forum picking up lessons, tips & tricks.


Fair enough, one thought, is there a way of modifying / changing the standard Function key shortcuts via VBA....?

Chat Soon.
You are welcome.
The VBA Application.OnKey method can be used to allow keystroke combinations to run a macro. If the combination of keystrokes is a 'standard', I believe the macro will run in preference to generating the 'standard' activity whenever the workbook containing the macro is open. I don't use shortcut keys to run macros so I have very little experience with this method. Here's a link you can look at:
Application.OnKey method (Excel)
 
Upvote 0

Forum statistics

Threads
1,212,927
Messages
6,110,724
Members
448,294
Latest member
jmjmjmjmjmjm

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top