VBA Code Add Condition

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
1,475
Office Version
  1. 2016
Platform
  1. Windows
Hello Friends,

I am using the this VBA Code to format dates which are greater than or equal to today.

I require to add another condition i.e. if the adjacent cell (right one) is empty then only the code should format dates otherwise nothing should happen.


Code:
Sub formatdates()

Dim rngCell As Range
Dim lngLstRow As Long
Dim strCol(1 To 9) As String


strCol(1) = "N"
strCol(2) = "P"
strCol(3) = "R"
strCol(4) = "T"
strCol(5) = "V"
strCol(6) = "X"
strCol(7) = "Z"
strCol(8) = "AB"
strCol(9) = "AD"


lngLstRow = ActiveSheet.UsedRange.Rows.Count


    For I = 1 To 9
        For Each rngCell In Range(strCol(I) & "4:" & strCol(I) & lngLstRow)
            If rngCell.Value >= Now() Then
                rngCell.Font.ColorIndex = 3
                
            Else
                rngCell.Font.ColorIndex = 1
                
            End If
        Next
    Next I


End Sub

Any help would be appreciated.

Regards,

Humayun
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Try
Code:
    For i = 1 To 9
        For Each rngcell In Range(strCol(i) & "4:" & strCol(i) & lngLstRow)
            If rngcell.Offset(, 1) = "" Then
               If rngcell.Value >= Date Then
                   rngcell.Font.ColorIndex = 3
                   
               Else
                   rngcell.Font.ColorIndex = 1
                   
               End If
            End If
        Next
    Next i
 
Upvote 0
Hi Fluff,

Thanks for the solution. Working PERFECT

Kind Regards :)
 
Upvote 0
You're welcome & thanks for the feedback
 
Upvote 0
Hi,
try

Code:
For I = 1 To 9
        For Each rngCell In Range(strCol(I) & "4:" & strCol(I) & lngLstRow)
         With rngCell
                .Font.ColorIndex = IIf(.Offset(, 1).Value = "" And .Value >= Date, 3, 1)
        End With
        Next
    Next I

Dave
 
Upvote 0
Hi Fluff & Dave

Code is not looking at the right cell to turn back black again the left cell when the data is there.

I did not notice it yesterday as the data is been copied from another worksheet to the current worksheet.
So if its a fresh data then its fine - otherwise the code is not working if any change is made in the current data

Dave solution is working fine.


Full Code
Code:
Sub fluff()

Dim rngCell As Range
Dim lngLstRow As Long
Dim strCol(1 To 4) As String


strCol(1) = "A"
strCol(2) = "C"
strCol(3) = "E"
strCol(4) = "G"




lngLstRow = ActiveSheet.UsedRange.Rows.Count


    For I = 1 To 4
        For Each rngCell In Range(strCol(I) & "4:" & strCol(I) & lngLstRow)
            If rngCell.Offset(, 1) = "" Then
               If rngCell.Value >= Date Then
                   rngCell.Font.ColorIndex = 3
                   
               Else
                   rngCell.Font.ColorIndex = 1
                   
               End If
            End If
        Next
    Next I


End Sub

Dave Code
Code:
Sub dave()

Dim rngCell As Range
Dim lngLstRow As Long
Dim strCol(1 To 4) As String


strCol(1) = "A"
strCol(2) = "C"
strCol(3) = "E"
strCol(4) = "G"




lngLstRow = ActiveSheet.UsedRange.Rows.Count


    For I = 1 To 4
        For Each rngCell In Range(strCol(I) & "4:" & strCol(I) & lngLstRow)
         With rngCell
                .Font.ColorIndex = IIf(.Offset(, 1).Value = "" And .Value >= Date, 3, 1)
        End With
        Next
    Next I
End Sub
 
Upvote 0
Hello,

I want a bit more from this code. One more thing needs to be added in the IF Function if possible.

If cell Value <= Date and adjacent cell is empty than I want a value in the adjacent cell & that should be today date minus cell date - besides the cell turning red which is fine and yes I would also want the adjacent cell to turn red also

For example cell has date lets say 10/7
Then the adjacent cell should show "5 Days Over" in there as current date is 15/7.
I want the difference of two dates.

Here is the code

Code:
Sub formatdates()Dim rngCell As Range
Dim lngLstRow As Long
Dim strCol(1 To 4) As String


strCol(1) = "A"
strCol(2) = "C"
strCol(3) = "E"
strCol(4) = "G"


lngLstRow = ActiveSheet.UsedRange.Rows.Count


    For I = 1 To 4
        For Each rngCell In Range(strCol(I) & "4:" & strCol(I) & lngLstRow)
         With rngCell
                .Font.ColorIndex = IIf(.Offset(, 1).Value = "" And .Value <= Date, 3, 1)
        End With
        Next
    Next I
    End Sub
 
Upvote 0
How about
Code:
Sub formatdates()
   Dim rngCell As Range
   Dim lngLstRow As Long
   Dim strCol(1 To 4) As String
   
   
   strCol(1) = "A"
   strCol(2) = "C"
   strCol(3) = "E"
   strCol(4) = "G"
   
   
   lngLstRow = ActiveSheet.UsedRange.Rows.Count
   
   
   For i = 1 To 4
      For Each rngCell In Range(strCol(i) & "4:" & strCol(i) & lngLstRow)
         With rngCell
            If .Offset(, 1).Value = "" And .Value <= Date Then
               .Resize(, 2).Font.ColorIndex = 3
               .Offset(, 1).Value = Date - .Value
            Else
               .Resize(, 2).Font.ColorIndex = 1
            End If
         End With
      Next rngCell
   Next i
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,530
Messages
6,114,163
Members
448,554
Latest member
Gleisner2

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