VBA: Identical If statement works in 3 out of 4 cases

T

toshimarise

New Member
Joined
Feb 1, 2013
Messages
21
This macro is pretty repetitive, sorry about that. It colors cells in two columns based on certain conditions. There are two columns (RangeToday and RangeYesterday). The operations are repeated on two tabs (Employees and Contractors).


Code: 
Sub Coloring()
' color codes apparent delinquencies for today and yesterday EOD
' checks for 0s, specific error codes ( U and L), comments, blanks, and error values

Dim LastCol As Long
Dim LastRow As Long

Sheets("Contractors").Activate
    With ActiveSheet
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        
    ' Last column (Today)
        

        Dim Cell As Range
        Set RangeToday = Range(Cells(2, LastCol), Cells(LastRow, LastCol))
        For Each Cell In RangeToday.Cells
        
        ' Color 0s red
            If Not IsError(Cell) Then
                If Cell.Value = "0" Then
                    Cell.Interior.Color = RGB(220, 0, 0)
                    Cell.Font.Bold = True
                End If
            End If
            
        'color errors grey
            If IsError(Cell) Then
                Cell.Interior.Color = RGB(200, 200, 200)
            End If
            
        ' color blanks grey
            If IsEmpty(Cell) Then
                Cell.Interior.Color = RGB(200, 200, 200)
            End If
            
        ' color comments yellow
            If Not Cell.Comment Is Nothing Then
                Cell.Interior.ColorIndex = 27
            End If
 

        Next
          
    ' 2nd  to last column (Yesterday EOD)
        Set RangeYesterdayEOD = Range(Cells(2, LastCol - 1), Cells(LastRow, LastCol - 1))
        For Each Cell In RangeYesterdayEOD.Cells

        If Not IsError(Cell) Then
        
            'color Ls red
            If Cell.Value Like "*L*" Then
                Cell.Interior.Color = RGB(220, 0, 0)
                Cell.Font.Bold = True
                      
            End If
            
            'color Us red
            If Cell.Value Like "*U*" Then
                Cell.Interior.Color = RGB(220, 0, 0)
                Cell.Font.Bold = True
            End If
            
        'color errors grey
   
        If IsError(Cell) Then
            Cell.Interior.Color = RGB(200, 200, 200)
        End If
        
        ' color blanks grey
        If IsEmpty(Cell) Then
            Cell.Interior.Color = RGB(200, 200, 200)
        End If
        
        ' color comments yellow
        If Not Cell.Comment Is Nothing Then
                Cell.Interior.ColorIndex = 27
        End If
        
        End If
        Next
    End With
    
' Employees sheet
Sheets("Employees").Activate
    With ActiveSheet
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        
    ' Last column (Today)
        

        Set RangeToday = Range(Cells(2, LastCol), Cells(LastRow, LastCol))
        For Each Cell In RangeToday.Cells
        
        ' Color 0s red
            If Not IsError(Cell) Then
                If Cell.Value = "0" Then
                    Cell.Interior.Color = RGB(220, 0, 0)
                    Cell.Font.Bold = True
                End If
            End If
            
        'color errors grey
            If IsError(Cell) Then
                Cell.Interior.Color = RGB(200, 200, 200)
            End If
            
        ' color blanks grey
            If IsEmpty(Cell) Then
                Cell.Interior.Color = RGB(200, 200, 200)
            End If
            
        ' color comments yellow
            If Not Cell.Comment Is Nothing Then
                Cell.Interior.ColorIndex = 27
            End If
 

        Next
          
    ' 2nd  to last column (Yesterday EOD)
        Set RangeYesterdayEOD = Range(Cells(2, LastCol - 1), Cells(LastRow, LastCol - 1))
        For Each Cell In RangeYesterdayEOD.Cells

        If Not IsError(Cell) Then
        
            'color Ls red
            If Cell.Value Like "*L*" Then
                Cell.Interior.Color = RGB(220, 0, 0)
                Cell.Font.Bold = True
                      
            End If
            
            'color Us red
            If Cell.Value Like "*U*" Then
                Cell.Interior.Color = RGB(220, 0, 0)
                Cell.Font.Bold = True
            End If
            
        'color errors grey

   ' THIS IS THE ONLY ONE NOT WORKING
        If IsError(Cell) Then
            Cell.Interior.Color = RGB(200, 200, 200)
        End If
        
        ' color blanks grey
        If IsEmpty(Cell) Then
            Cell.Interior.Color = RGB(200, 200, 200)
        End If
        
        ' color comments yellow
        If Not Cell.Comment Is Nothing Then
                Cell.Interior.ColorIndex = 27
        End If
        
        End If
        Next
    End With
End Sub

Most of it works fine, but one of the color-change conditions that appears on both tabs does not always work (marked by a comment in the code). In the RangeYesterdayEOD on the Employees tab, the IsError condition doesn't turn any cells grey, even if they contain an error. All the other conditions are working fine in all four columns. Also the IsError condition works fine in the other 3 columns.

Any help is much appreciated!
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Sort by date Sort by votes
Hi toshimarise,

They are not identical. There is an "End If" statement in the wrong place that causes the IsError(Cell) code to be skipped over.

Code: 
 For Each Cell In RangeYesterdayEOD.Cells
   If Not IsError(Cell) Then
      'color Ls red
      If Cell.Value Like "*L*" Then
          Cell.Interior.Color = RGB(220, 0, 0)
          Cell.Font.Bold = True
                
      End If
            
      'color Us red
      If Cell.Value Like "*U*" Then
          Cell.Interior.Color = RGB(220, 0, 0)
          Cell.Font.Bold = True
      End If
[COLOR="#0000CD"][B]   End If ' <---Missing[/B][/COLOR]
   
   'color errors grey
   
   ' THIS IS THE ONLY ONE NOT WORKING
   If IsError(Cell) Then
       Cell.Interior.Color = RGB(200, 200, 200)
   End If
   
   ' color blanks grey
   If IsEmpty(Cell) Then
       Cell.Interior.Color = RGB(200, 200, 200)
   End If
   
   ' color comments yellow
   If Not Cell.Comment Is Nothing Then
           Cell.Interior.ColorIndex = 27
   End If
[B][COLOR="#0000CD"]   End If  ' <---Remove this[/COLOR][/B]
 Next


toshimarise said:
This macro is pretty repetitive, sorry about that.
Click to expand...

Modifying your sub to have code for one process that is applied to each range of each sheet will make it easier for you to maintain and avoid errors like this. It's well worth the initial effort! :)

Just ask if you want some help doing that.
 
Upvote 0
Thank you for finding the endif issue, that did indeed fix the problem. I had so many nested I couldn't even see it! :)

I would definitely like help making a repeatable process for each sheet, if you would be so kind.
 
Upvote 0
toshimarise said:
I would definitely like help making a repeatable process for each sheet, if you would be so kind.
Click to expand...

Glad that helped. :)

I've reworked the code to streamline the 4 repetitive parts to 1. To make it a little easier to see the connection to your original code, I've posted an intermediate version below that streamlines the 4 parts to 2.

Code: 
Option Explicit

Sub Coloring2()
 '--call procedure to add colors to each sheet
 Call ColorCodeRange(wks:=Sheets("Contractors"))
 Call ColorCodeRange(wks:=Sheets("Employees"))
End Sub

Private Sub ColorCodeRange(wks As Worksheet)
' color codes apparent delinquencies for today and yesterday EOD on sheet wks
' checks for 0s, specific error codes ( U and L), comments, blanks, and error values

 Dim LastCol As Long
 Dim LastRow As Long
 Dim Cell As Range
 Dim RangeToday As Range
 Dim RangeYesterdayEOD As Range

 With wks
   LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
   LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    ' Last column (Today)
   Set RangeToday = Range(.Cells(2, LastCol), .Cells(LastRow, LastCol))
   For Each Cell In RangeToday.Cells
   ' Color 0s red
       If Not IsError(Cell) Then
           If Cell.Value = "0" Then
               Cell.Interior.Color = RGB(220, 0, 0)
               Cell.Font.Bold = True
           End If
       End If
       
   'color errors grey
       If IsError(Cell) Then
           Cell.Interior.Color = RGB(200, 200, 200)
       End If
       
   ' color blanks grey
       If IsEmpty(Cell) Then
           Cell.Interior.Color = RGB(200, 200, 200)
       End If
       
   ' color comments yellow
       If Not Cell.Comment Is Nothing Then
           Cell.Interior.ColorIndex = 27
       End If
   Next
          
 ' 2nd  to last column (Yesterday EOD)
   Set RangeYesterdayEOD = Range(.Cells(2, LastCol - 1), .Cells(LastRow, LastCol - 1))
   For Each Cell In RangeYesterdayEOD.Cells

     If Not IsError(Cell) Then
     
         'color Ls red
         If Cell.Value Like "*L*" Then
             Cell.Interior.Color = RGB(220, 0, 0)
             Cell.Font.Bold = True
                   
         End If
         
         'color Us red
         If Cell.Value Like "*U*" Then
             Cell.Interior.Color = RGB(220, 0, 0)
             Cell.Font.Bold = True
         End If
         
     'color errors grey
     If IsError(Cell) Then
         Cell.Interior.Color = RGB(200, 200, 200)
     End If
     
     ' color blanks grey
     If IsEmpty(Cell) Then
         Cell.Interior.Color = RGB(200, 200, 200)
     End If
     
     ' color comments yellow
     If Not Cell.Comment Is Nothing Then
             Cell.Interior.ColorIndex = 27
     End If
     
     End If
     Next
 End With
   
End Sub
 
Upvote 0
Using the code in my last post, the code below is further consolidated from 2 repetitive parts to 1 along with some other improvements.

Paste all this code into a separate code module from the example in my last post.

Code: 
Option Explicit

'--enum used to loop logic more understandable
Enum DayTypes
 mYesterday = 0
 mtoday = 1
End Enum

Sub Coloring3()
 '--call procedure to add colors to each sheet
 Call ColorCodeRange(wks:=Sheets("Contractors"))
 Call ColorCodeRange(wks:=Sheets("Employees"))
End Sub

Private Sub ColorCodeRange(wks As Worksheet)
' color codes apparent delinquencies for today and yesterday EOD on sheet wks
' checks for 0s, specific error codes ( U and L), comments, blanks, and error values

 Dim LastCol As Long, LastRow As Long, CurCol As Integer
 Dim Cell As Range, RangeToProcess As Range
 Dim sValue As String
 
 With wks
   LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
   LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

   '--define range of today's and yesterday's data
   Set RangeToProcess = Range(.Cells(2, LastCol), .Cells(LastRow, LastCol - 1))
 End With
    
 '--when CurCol is 0: 2nd  to last column (yesterday EOD)
 '--when CurCol is 1: last column(today)
 For CurCol = mYesterday To mtoday
   For Each Cell In RangeToProcess.Resize(, 1).Offset(0, CurCol)
      If IsError(Cell.Value) Then
         'color errors grey
         Cell.Interior.Color = RGB(200, 200, 200)
      ElseIf Len(Cell.Value) = 0 Then
         'color blank cells grey
         Cell.Interior.Color = RGB(200, 200, 200)
      Else
         sValue = Cell.Value
         If CurCol = mYesterday Then
            If sValue Like "*L*" Or sValue Like "*U*" Then
               'color yesterday's Ls and Us red
               Cell.Interior.Color = RGB(220, 0, 0)
               Cell.Font.Bold = True
            End If
         ElseIf CurCol = mtoday Then
            If sValue = "0" Then
               'color today's 0s red
               Cell.Interior.Color = RGB(220, 0, 0)
               Cell.Font.Bold = True
            End If
         End If
      End If
      
      If Not Cell.Comment Is Nothing Then
         'color comments yellow- goes last
         'to override any other colors assigned
         Cell.Interior.ColorIndex = 27
      End If
   Next Cell
 Next CurCol
         
End Sub
 
Upvote 0
Wow, I feel like just reading through these progressive examples leveled up my coding skills. You were right, that intermediate step does help a lot with comprehension. :)

Unfortunately, the project got "de-prioritized" for now so I probably won't have time to play with it for a week or more. Thank you so much for helping though!
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
Faster vba code for adding a total column, creating pivot and then copying pasting data
Replies
0
Views
474
Monicasinha
M
Q
  • Question
VBA With Worksheets Statement Limitations?
Replies
5
Views
679
QueenOfLean
Q
G
  • Question
VBA Offset Color property not Working
Replies
3
Views
4K
Fluff
Fluff
V
  • Question
VBA Loop getting break automatically
Replies
7
Views
922
baitmaster
baitmaster
E
  • Question
Cannot Find Missing Statement Closing
Replies
4
Views
727
erickamiller143
E

Forum statistics

Threads
1,216,058
Messages
6,128,538
Members
449,456
Latest member
SammMcCandless

Share this page

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