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,523
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,523
Office Version
365
Platform
Windows
You're welcome & thanks for the feedback
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
5,157
Office Version
2013
Platform
Windows
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,157
Office Version
2013
Platform
Windows
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,523
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,078,437
Messages
5,340,278
Members
399,362
Latest member
iayb

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...
Top