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]

Let's stick to one problem at a time. You have not changed the if statements as I showed.
Also NEVER use "On Error Resume Next" in that manner, as it will simply hide problems.

Well I did change as you said so
but getting debug msg. Compile error ... End with without with

 

[Fluff]

Can you post that code?

 

[hrayani]

Can you post that code?

Sure, why not

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)
         With rngCell
         
      If .Value <> "" Then
            
    If .Offset(, 1).Value = "" And .Value < Date And Date - .Value > 1 And .Value <> "" Then
     .Resize(, 2).Font.ColorIndex = 3
     .Offset(, 1).Value = Date - .Value & " Days"
            
    ElseIf .Offset(, 1).Value = "" And .Value < Date And Date - .Value = 1 And .Value <> "" Then
     .Resize(, 2).Font.ColorIndex = 3
     .Offset(, 1).Value = Date - .Value & " Day"
            
    ElseIf .Offset(, 1).Value = "" And .Value = Date And .Value <> "" 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 With
      Next rngCell
   Next I
End Sub

 

[Fluff]

How about

   For i = 1 To 9
      For Each rngCell In Range(strCol(i) & "4:" & strCol(i) & lngLstRow)
         With rngCell
            If .Value <> "" Then
               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

 

[hrayani]

Not working friend.

Run time error 13 type mismatch

This part of the code highlighted

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

 

[Fluff]

What is the value of rngCell & the cell to the right when you get the error?

 

[hrayani]

What is the value of rngCell & the cell to the right when you get the error?

Both rngCell & the cell to the right can have below possible values

1) Blank Cell ------------> But if you apply isblank formula to a cell having no values will result FALSE... It wont return true
2) A Date
3) text "Not Applicable"

Please note that all above possible values are copied from some other sheet & they are results of a formula and then pasted here as paste special values.

 

[Fluff]

What are the EXACT values when you get the error?
Also for the date is you use =ISNUMBER(C2) where C2 is one of the dates, what does it return.

 

[hrayani]

What are the EXACT values when you get the error?
Also for the date is you use =ISNUMBER(C2) where C2 is one of the dates, what does it return.

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

For example this formula gives me an error #N/A

=IF(AN726="Not Applicable","Not Applicable",INDEX(fri_dpi_labtest_date,MATCH(1,($A726=fri_dpi_labtest_po)*("FRI 3"=fri_dpi_labtest_category),0)))

So to control this I applied iferror function

=IFERROR(IF(AN726="Not Applicable","Not Applicable",INDEX(fri_dpi_labtest_date,MATCH(1,($A726=fri_dpi_labtest_po)*("FRI 3"=fri_dpi_labtest_category),0))),"")

And where there is a date if I use =isnumber() I get TRUE as a result

 

[Fluff]

Please answer my first question