Results 1 to 3 of 3

Thread: Vba conditional formatting

  1. #1

    Vba conditional formatting



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hi All,

    I've got this code which works great but It works for the whole spreadsheet. How to I adapt it to work for cells a13 to ho140

    CHEERS


    Code:
    Option Compare Text 'A=a, B=b, ... Z=z
     
    Option Explicit
     
    Private Sub Worksheet_Change(ByVal Target As Range)
         If ActiveCell.Value = "Full Fail" Or ActiveCell.Value = "Sense Fail" Then
     
            MsgBox "Please ensure you complete 3 full audits", vbInformation, "Complete the reason for Fail - Right click and insert comment"
          End If
     
    Dim Cell As Range
    Dim Rng1 As Range
      
        On Error Resume Next
        Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)
        On Error GoTo 0
     
        If Rng1 Is Nothing Then
     
            Set Rng1 = Range(Target.Address)
        Else
     
            Set Rng1 = Union(Range(Target.Address), Rng1)
         End If
     
        For Each Cell In Rng1
     
            Select Case Cell.Value
     
                 Case vbNullString
     
                     Cell.Interior.ColorIndex = xlNone
                      Cell.Font.Bold = False
     
                 Case "Full Fail", "Sense Fail"
     
                     Cell.Interior.ColorIndex = 3
                      Cell.Font.Bold = True
     
                 Case "Sense in progress", "Full in progress"
     
                     Cell.Interior.ColorIndex = 6
                      Cell.Font.Bold = True
     
                 Case "Full Pass", "Sense Pass"
     
                     Cell.Interior.ColorIndex = 35
                      Cell.Font.Bold = True
     
                 Case Else
     
                      Cell.Interior.ColorIndex = xlNone
                       Cell.Font.Bold = False
     
            End Select
          Next
      End Sub
    Last edited by Bob Phillips; 2012-02-23 at 09:19 AM. Reason: Added code tags

  2. #2
    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cell As Range
    Dim Rng1 As Range
    
    
    
    
        If Not Intersect(Target, Me.Range("A13:HO140")) Is Nothing Then
        
            If Target.Value = "Full Fail" Or Target.Value = "Sense Fail" Then
        
                MsgBox "Please ensure you complete 3 full audits", vbInformation, _
                       "Complete the reason for Fail - Right click and insert comment"
            End If
    
    
            On Error Resume Next
                Set Rng1 = Me.Cells.SpecialCells(xlCellTypeFormulas, 1)
            On Error GoTo 0
    
    
            If Rng1 Is Nothing Then
    
    
                Set Rng1 = Target
            Else
    
    
                Set Rng1 = Union(Target, Rng1)
            End If
                
            For Each Cell In Rng1
            
                Select Case Cell.Value
                
                    Case vbNullString
                    
                        Cell.Interior.ColorIndex = xlNone
                        Cell.Font.Bold = False
                    
                    Case "Full Fail", "Sense Fail"
                    
                        Cell.Interior.ColorIndex = 3
                        Cell.Font.Bold = True
                    
                    Case "Sense in progress", "Full in progress"
                        
                        Cell.Interior.ColorIndex = 6
                        Cell.Font.Bold = True
                    
                    Case "Full Pass", "Sense Pass"
                    
                        Cell.Interior.ColorIndex = 35
                        Cell.Font.Bold = True
                    
                    Case Else
                    
                        Cell.Interior.ColorIndex = xlNone
                        Cell.Font.Bold = False
                End Select
            Next
        End If
    End Sub

  3. #3
    Works great thanks v much. Only issue is when I copy and paste or drag information I get a runtime 13 error

Posting Permissions

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