Results 1 to 2 of 2

Thread: Macros to highlight three or more consecutive numbers entered in a set row

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #2
    VBAX Expert
    Joined
    Sep 2016
    Posts
    788
    Location
    You can use "conditional formatting"

    Option Explicit
    
    Sub test()
        Dim tbl As Range
        Dim r(1 To 6) As Range
        Dim f(1 To 6) As String
        Dim k As Long
        Dim fc As FormatCondition
        
        Set tbl = Range("B2:M32")
        
        Set r(1) = tbl.Resize(, tbl.Columns.Count - 2)
        Set r(2) = r(1).Offset(, 1)
        Set r(3) = r(1).Offset(, 2)
        
        Set r(4) = tbl.Resize(tbl.Rows.Count - 2)
        Set r(5) = r(4).Offset(1)
        Set r(6) = r(4).Offset(2)
        
        f(1) = "=COUNTIFS(" & r(1).Address(, , xlR1C1) & ",rc," _
                            & r(2).Address(, , xlR1C1) & ",rc[1]," _
                            & r(3).Address(, , xlR1C1) & ",rc[2])>1"
                    
        f(2) = "=COUNTIFS(" & r(1).Address(, , xlR1C1) & ",rc[-1]," _
                            & r(2).Address(, , xlR1C1) & ",rc," _
                            & r(3).Address(, , xlR1C1) & ",rc[1])>1"
                     
        f(3) = "=COUNTIFS(" & r(1).Address(, , xlR1C1) & ",rc[-2]," _
                            & r(2).Address(, , xlR1C1) & ",rc[-1]," _
                            & r(3).Address(, , xlR1C1) & ",rc)>1"
                     
            f(4) = "=COUNTIFS(" & r(4).Address(, , xlR1C1) & ",rc," _
                                & r(5).Address(, , xlR1C1) & ",r[1]c," _
                                & r(6).Address(, , xlR1C1) & ",r[2]c)>1"
                        
            f(5) = "=COUNTIFS(" & r(4).Address(, , xlR1C1) & ",r[-1]c," _
                                & r(5).Address(, , xlR1C1) & ",rc," _
                                & r(6).Address(, , xlR1C1) & ",r[1]c)>1"
                         
            f(6) = "=COUNTIFS(" & r(4).Address(, , xlR1C1) & ",r[-2]c," _
                                & r(5).Address(, , xlR1C1) & ",r[-1]c," _
                                & r(6).Address(, , xlR1C1) & ",rc)>1"
                     
        tbl.FormatConditions.Delete
        
        For k = 1 To 6
            Set fc = r(k).FormatConditions.Add(Type:=xlExpression, Formula1:=f(k))
            fc.Font.Underline = True
        Next
    
    
    End Sub

    マナ
    Last edited by mana; 06-22-2019 at 07:44 PM.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •