VBA Code Add Condition

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
855
Office Version
2016
Platform
Windows
Hi Fluff,

Code Is Working Fine. I amended a code a bit for my additional requirements.


From This
Code:
If .Offset(, 1).Value = "" And .Value <= Date Then

To This - Coz I wanted another criteria i.e. if Date is blank then nothing should happen
Code:
If .Offset(, 1).Value = "" And .Value <= Date And .Value <> "" Then


From This
Code:
.Offset(, 1).Value = Date - .Value

To This - Coz I wanted text like 45 Day(s)
Code:
.Offset(, 1).Value = Date - .Value & " Day(s)"
So far its working fine. I am working on few more things like if the days difference is a single day then Day should be there instead of Days and if the difference is 0 then it should show Today etc.

First I will try then will bother you if I fail to accomplish.

Keep you posted.

Regards,

Humayun
 

Some videos you may like

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

Fluff

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

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
855
Office Version
2016
Platform
Windows
Hello Fluff

This is what I have come up with

Code:
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"
If date difference is > 1 day Then For example 2 Days
If date difference is = 1 day Then 1 Day
If date difference is = 0 i.e. current date Then Today


I am not sure if there is a better way to write it...
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,538
Office Version
365
Platform
Windows
If it works, it's good :)
Added to which you understand it, so easier for you to modify in future if needed.
 
Last edited:

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
855
Office Version
2016
Platform
Windows
Hi Fluff,

I am having a problem. The data on which this code is being applied is copied from a different worksheet to the current worksheet.

i.e. copy then paste special > values.

Some are results of formula. For example
=IF(A1=B1,"")
and if the logic is met then the answer returns
- then it is copied and then paste special as value to the current worksheet. So when this happens the code debugs whith the first line of the code highlighted and giving a msg > runtime error 13 - type mismatch


Code:
 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"
Kindly let me know how to overcome this issue
 
Last edited:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,538
Office Version
365
Platform
Windows
Check that you don't have any errors in the cells. ie #N/A, #VALUE! etc
 
Last edited:

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
855
Office Version
2016
Platform
Windows
Check that you don't have any errors in the cells. ie #N/A, #VALUE ! etc
No there are no errors as I have applied iferror on all formulas
 
Last edited:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,538
Office Version
365
Platform
Windows
In that case you will need to check that the cell isn't "" before you subtract it from Date.
Code:
            If .Value <> "" Then
               If .Offset(, 1).Value = "" And .Value < Date And Date - .Value > 1 Then
 

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
855
Office Version
2016
Platform
Windows
I tried but getting debug msg. Compile error ... End with without with


Also I wanted if the cell has "Not Applicable" in there then the code should not turn it to red

I did a bit of experiment and came up with this
Red Parts added in the code.

Code:
  [B][COLOR=#ff0000]On Error Resume Next[/COLOR][/B]            
    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
         
[COLOR=#ff0000][B]         If .Value = "Not Applicable" Then[/B][/COLOR]
[COLOR=#ff0000][B]         .Resize(, 2).Font.ColorIndex = 1[/B][/COLOR]
         
         End If
         End With
      Next rngCell
   Next I
Kindly let me know if its OK
 

Fluff

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

Watch MrExcel Video

Forum statistics

Threads
1,095,310
Messages
5,443,711
Members
405,247
Latest member
Whatdoidonow

This Week's Hot Topics

Top