Conditional Formatting - How to Highlight cells in a row (Up to 5) if they have consecutive "ascending" numbers with different colors.

[rennesan]

Conditional Formatting - How to Highlight cells in a row (Up to 5) if they have consecutive "ascending" numbers with different colors based on the matching criteria.

For example:

Sequence Numbers (50,57,58,60,70), (101,102,103,200,205), (300, 402,403,404,405) and (7,8,9,10,11)

If 2 consecutive numbers are found, consecutive numbers are highlighted GREEN (50,57,58,60,70)
If 3 consecutive numbers are found, consecutive numbers are highlighted YELLOW (101,102,103,200,205)
If 4 consecutive numbers are found, consecutive numbers are highlighted ORANGE (300, 402,403,404,405)
If 5 consecutive numbers are found, consecutive numbers are highlighted RED (7,8,9,10,11)

If color coding to this extent is not a possibility, at least highlight the consecutive numbers with one color.

Thank you in Advance,

Renne

 

[Peter_SSs]

Welcome to the MrExcel board!

at least highlight the consecutive numbers with one color.

That is not so bad. Assuming we can have an empty column on each side of the data, try this.

21 02 20.xlsm
	A	B	C	D	E	F	G
1		50	57	58	60	70
2		101	102	103	200	205
3		300	402	403	404	405
4		7	8	9	10	11
CF Seq

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B1:F4	Expression	=OR(AND(B1=A1+1,A1<>""),AND(B1=C1-1,C1<>""))	text	NO

 

[Peter_SSs]

You could also try this vba code. It could be made more dynamic like CF if required if we knew just where the data is, if it is always 5 columns, if it is manually entered or evaluated by formula etc.
If you want to test this, make a copy of your data and remove any existing Conditional Formatting.

Sub Recolour()
  Dim a As Variant, Clrs As Variant
  Dim i As Long, j As Long, fc As Long, k As Long, uba2 As Long
 
  Clrs = Split("0 0 10 6 45 3")
  Application.ScreenUpdating = False
  With Range("A1", Range("E" & Rows.Count).End(xlUp))
    .Interior.Color = xlNone
    a = .Value
    uba2 = UBound(a, 2)
    For i = 1 To UBound(a)
      k = 1
      fc = 1
      For j = 2 To uba2
        If a(i, j) = a(i, j - 1) + 1 Then
          k = k + 1
          If k > 1 Then .Cells(i, fc).Resize(, k).Interior.ColorIndex = Clrs(k)
        Else
          fc = j
          k = 1
        End If
      Next j
    Next i
  End With
  Application.ScreenUpdating = True
End Sub

rennesan.xlsm
	A	B	C	D	E
1	50	57	58	60	70
2	101	102	103	200	205
3	300	402	403	404	405
4	7	8	9	10	11
5	8	9	12	20	21
CF Seq (2)

 

[rennesan]

Welcome to the MrExcel board!


That is not so bad. Assuming we can have an empty column on each side of the data, try this.

21 02 20.xlsm
	A	B	C	D	E	F	G
1		50	57	58	60	70
2		101	102	103	200	205
3		300	402	403	404	405
4		7	8	9	10	11
CF Seq

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B1:F4	Expression	=OR(AND(B1=A1+1,A1<>""),AND(B1=C1-1,C1<>""))	text	NO

WOW!!! That was a quick response!!! I tested out this and worked great!

Thank you very much!

Renné

PS - I will test out the VB Script tomorrow. Thank you again!

 

[Peter_SSs]

Thank you very much!

Renné

You're welcome. Thanks for the follow-up.

I will test out the VB Script tomorrow.

OK, cheers. Just post back with details if you want further help with that.

 

[rennesan]

You could also try this vba code. It could be made more dynamic like CF if required if we knew just where the data is, if it is always 5 columns, if it is manually entered or evaluated by formula etc.
If you want to test this, make a copy of your data and remove any existing Conditional Formatting.

Sub Recolour()
  Dim a As Variant, Clrs As Variant
  Dim i As Long, j As Long, fc As Long, k As Long, uba2 As Long

  Clrs = Split("0 0 10 6 45 3")
  Application.ScreenUpdating = False
  With Range("A1", Range("E" & Rows.Count).End(xlUp))
    .Interior.Color = xlNone
    a = .Value
    uba2 = UBound(a, 2)
    For i = 1 To UBound(a)
      k = 1
      fc = 1
      For j = 2 To uba2
        If a(i, j) = a(i, j - 1) + 1 Then
          k = k + 1
          If k > 1 Then .Cells(i, fc).Resize(, k).Interior.ColorIndex = Clrs(k)
        Else
          fc = j
          k = 1
        End If
      Next j
    Next i
  End With
  Application.ScreenUpdating = True
End Sub

rennesan.xlsm
	A	B	C	D	E
1	50	57	58	60	70
2	101	102	103	200	205
3	300	402	403	404	405
4	7	8	9	10	11
5	8	9	12	20	21
CF Seq (2)

This VB Script also worked really well!!!

 

[Peter_SSs]

This VB Script also worked really well!!!

Cheers. Thanks for the confirmation.