VBA Code Add Condition

[hrayani]

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.

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

 

[hrayani]

Please answer my first question

What are the EXACT values when you get the error?

I already answered it in my last post

the error value I get is #N/A & to control this I use iferror function to not to get errors

​Am I still not understanding anything ???

EDIT..
The sheet where the code is applied don't get any errors. As all the values in the entire sheet are copied from another sheet and pasted in this sheet as paste special value.

As far as the error point is concerned. It is there in the worksheet from where all the values are copied and pasted in this sheet and to control all the formula results which might give error I use the Iferror function.
I hope its clear now

 

[Fluff]

When you get the error, what is the value of rngCell?

 

[hrayani]

When you get the error, what is the value of rngCell?

When I get an error in lets say Sheet1 I control that by using the Iferror function in there for example =iferror(xxxxxxxxx),"")
Then I copy the cell and paste (paste special values) it in Sheet2 where the code is being applied.

So the value of the ringCell is nothing. I mean it shows a blank cell. But if you use an isblank function it will show False.

 

[Fluff]

Yes, but with this code

            [COLOR=#ff0000]If .Value <> "" Then[/COLOR]
               If .Offset(, 1).Value = "" And .Value < Date And Date - .Value > 1 Then
                  .Resize(, 2).Font.ColorIndex = 3
                  .Offset(, 1).Value = Date - .Value & " Days"
               ElseIf .Offset(, 1).Value = "" And .Value < Date And Date - .Value = 1 Then
                  .Resize(, 2).Font.ColorIndex = 3
                  .Offset(, 1).Value = Date - .Value & " Day"
               ElseIf .Offset(, 1).Value = "" And .Value = Date Then
                  .Resize(, 2).Font.ColorIndex = 3
                  .Offset(, 1).Value = "Today"
               Else
                  .Resize(, 2).Font.ColorIndex = 1
               End If
               If .Value = "Not Applicable" Then
                  .Resize(, 2).Font.ColorIndex = 1
               End If
            [COLOR=#ff0000]End If[/COLOR]

If the value ="" then it will jump from the 1st red line to the 2nd, so that is not the problem.
What line do you get the error on?

 

[hrayani]

the first line

If .Offset(, 1).Value = "" And .Value < Date And Date - .Value > 1 And .Value <> "" Then

 

[Fluff]

That is not from the code I posted.
How is anyone expected to help you if you either don't use the suggested code, or change it without saying anything?
Please post the code you are currently using.

 

[hrayani]

That is not from the code I posted.
How is anyone expected to help you if you either don't use the suggested code, or change it without saying anything?
Please post the code you are currently using.

I apologise

Neither a code other than the suggested one is used nor any changes have been made to the code
I have the previous code in the file with a different name which I was using & its just that I chose the wrong code to select this very line of the code to paste here


Tested again - This line is giving run time error - 13. Type mismatch

  If .Offset(, 1).Value = "" And .Value < Date And Date - .Value > 1 Then

 

[Fluff]

In that case either rngCell is not "" or there is a problem with the value in the column to the right.
Add the 2 message boxes as shown

   For I = 1 To 9
      For Each rngCell In Range(strCol(I) & "4:" & strCol(I) & lngLstRow)
         With rngCell
            If .Value <> "" Then
               [COLOR=#0000ff]MsgBox rngCell.Value
               MsgBox rngCell.Offset(, 1).Value[/COLOR]
               If .Offset(, 1).Value = "" And .Value < Date And Date - .Value > 1 Then
                  .Resize(, 2).Font.ColorIndex = 3
                  .Offset(, 1).Value = Date - .Value & " Days"
               ElseIf .Offset(, 1).Value = "" And .Value < Date And Date - .Value = 1 Then
                  .Resize(, 2).Font.ColorIndex = 3
                  .Offset(, 1).Value = Date - .Value & " Day"
               ElseIf .Offset(, 1).Value = "" And .Value = Date Then
                  .Resize(, 2).Font.ColorIndex = 3
                  .Offset(, 1).Value = "Today"
               Else
                  .Resize(, 2).Font.ColorIndex = 1
               End If
               If .Value = "Not Applicable" Then
                  .Resize(, 2).Font.ColorIndex = 1
               End If
            End If
         End With
      Next rngCell
   Next I

Which one gives the error

 

[hrayani]

As soon as I run the code - I keep on getting msg boxes. Some with Dates & some Blank Msg Box.
When press Ok on the Msg Box - another appears


EDIT:
This might be the problem....
Some blanks are return TRUE if isblank is applied
Some blanks are return FALSE if isblank is applied

 

[hrayani]

I tried the code on a whole new sheet. And Its working .... Confused

There might be some problem with my data extraction into the current sheet - I reckon. Otherwise it would not have worked in the new sheet