VBA Code Add Condition

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
754
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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,213
Office Version
365
Platform
Windows
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
 

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
754
Hi Fluff,

Thanks for the solution. Working PERFECT

Kind Regards :)
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,213
Office Version
365
Platform
Windows
You're welcome & thanks for the feedback
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
5,135
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
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
5,135
Thanks Dave

Will try that too
You are welcome - I don't type as fast as Fluff - solution untested but hopefully will work.

Dave
 

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
754
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
 

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
754
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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,213
Office Version
365
Platform
Windows
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
 

Forum statistics

Threads
1,077,795
Messages
5,336,374
Members
399,078
Latest member
johnk94

Some videos you may like

This Week's Hot Topics

Top