• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Macro to highlight a range if it contains ticket ranges

Bimmy

Member
Data's are pasted into cells in Range C which contains ticket ranges.

Below are the ticket ranges

ST388 - ST404
CR510 - CR528

What the macro should do -

As soon as the data is pasted in Range C, Range C should get highlight in RED if the data contains above mentioned Ticket Ranges. (Without pressing ALT+F8)

Code:
Sub Format()

    Dim LastRow As Double
    Dim sht As Worksheet: Set sht = ThisWorkbook.Sheets("Sheet1")
    Dim i As Double
    LastRow = sht.Cells(sht.Rows.Count, "C").End(xlUp).Row + 1
   
    With sht
        For i = 1 To LastRow
            Debug.Print Right(.Range("C" & i), 3)
            Debug.Print Right(.Range("C" & i), 3) > 387
            If Right(.Range("C" & i), 3) > 387 And Right(.Range("C" & i), 3) < 405 Then
                .Range("C" & i).Interior.Color = RGB(255, 0, 0)
            End If
        Next i
    End With
End Sub

The above code highlights Range C if it only contains the Ticket Range
Ex :
Range C - - - - Result
ST388 - - - - - Highlights in RED

Since the data will be recorded across multiple sheets, the macro should highlight Range C no matter which sheet the data is pasted.

Note -

The code works only for ticket range ST388 - ST404.
It should also work for CR510 - CR528

Have attached sample sheet with dummy data across 3 sheets
 

Attachments

  • Range.xlsm
    15.1 KB · Views: 0
In the ThisWorkbook module, delete your previous code, and put this:
Code:
Private Sub Workbook_SheetChange(ByVal Sht As Object, ByVal Target As Range)
    Dim c As Range
    Dim myNum As Long
    Target.Interior.Color = xlNone
    For Each c In Target
        If c.Value <> "" Then
            myNum = CLng(Right(Trim(c.Value), 3))
            If (myNum >= 388 And myNum < 404) Or (myNum >= 510 And myNum <= 528) Then
                c.Interior.Color = RGB(255, 0, 0)
            End If
        End If
    Next c
End Sub
 
Getting below error -

Run-time error '13':
Type mismatch

and below code gets highlighted in yellow -

Code:
myNum = CLng(Right(Trim(c.Value), 3))
 
Very similar to Luke M's code but since your ticket numbers all seem to be at the left of the cell value rather than the right I've made an adjustment for that.
Also it makes sure the CR/ST prefix is taken account of
Only the cells in column C are checked.
There's also a small shading difference between the ST and CR but if you don't want that just change:
RGB(255, 100, 0)
to:
RGB(255, 0, 0)
Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim RngToCheck As Range
Set RngToCheck = Intersect(Sh.Columns(3), Target)
If Not RngToCheck Is Nothing Then
  For Each cll In RngToCheck.Cells
        cll.Interior.ColorIndex = xlNone
    Select Case UCase(Left(cll.Value, 2))
      Case "CR"
        myNo = Val(Mid(cll.Value, 3,3))
        If myNo >= 510 And myNo <= 528 Then cll.Interior.Color = RGB(255, 0, 0)
      Case "ST"
        myNo = Val(Mid(cll.Value, 3,3))
        If myNo >= 388 And myNo <= 404 Then cll.Interior.Color = RGB(255, 100, 0)
    End Select
  Next cll
End If
End Sub
 
Last edited:
p45cal.... Exactly what I'm looking for.

Data is pasted in Range C in 2 ways -
1) Spaces before the Ticket Ranges (Ex as below)
2) Without spaces before the Ticket Ranges (Ex as below)

--ST389 xxx xxx xxxxx (-- assume them as spaces)
ST389 xxx xxx xxxxx (without space before the ticket range)

The code provided by you highlights in RED if there are no Spaces before the Ticket Range.

Want the code to also highlight if there are spaces just before the Ticket Range.
 
Back
Top