Page 1 of 5 123 ... LastLast
Results 1 to 10 of 41

Thread: VBA Code Add Condition
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    Board Regular
    Join Date
    Jul 2010
    Posts
    721
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default VBA Code Add Condition

    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
    The tragedy of life doesn't lie in not reaching your goal. The tragedy lies in having no goal to reach.

  2. #2
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    28,353
    Post Thanks / Like
    Mentioned
    471 Post(s)
    Tagged
    47 Thread(s)

    Default Re: VBA Code Add Condition

    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
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  3. #3
    Board Regular
    Join Date
    Jul 2010
    Posts
    721
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA Code Add Condition

    Hi Fluff,

    Thanks for the solution. Working PERFECT

    Kind Regards
    The tragedy of life doesn't lie in not reaching your goal. The tragedy lies in having no goal to reach.

  4. #4
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    28,353
    Post Thanks / Like
    Mentioned
    471 Post(s)
    Tagged
    47 Thread(s)

    Default Re: VBA Code Add Condition

    You're welcome & thanks for the feedback
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  5. #5
    Board Regular
    Join Date
    Jul 2012
    Location
    Hampshire, UK
    Posts
    5,051
    Post Thanks / Like
    Mentioned
    27 Post(s)
    Tagged
    1 Thread(s)

    Default Re: VBA Code Add Condition

    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

  6. #6
    Board Regular
    Join Date
    Jul 2010
    Posts
    721
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA Code Add Condition

    Thanks Dave

    Will try that too
    The tragedy of life doesn't lie in not reaching your goal. The tragedy lies in having no goal to reach.

  7. #7
    Board Regular
    Join Date
    Jul 2012
    Location
    Hampshire, UK
    Posts
    5,051
    Post Thanks / Like
    Mentioned
    27 Post(s)
    Tagged
    1 Thread(s)

    Default Re: VBA Code Add Condition

    Quote Originally Posted by hrayani View Post
    Thanks Dave

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

    Dave

  8. #8
    Board Regular
    Join Date
    Jul 2010
    Posts
    721
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA Code Add Condition

    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
    The tragedy of life doesn't lie in not reaching your goal. The tragedy lies in having no goal to reach.

  9. #9
    Board Regular
    Join Date
    Jul 2010
    Posts
    721
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA Code Add Condition

    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
    The tragedy of life doesn't lie in not reaching your goal. The tragedy lies in having no goal to reach.

  10. #10
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    28,353
    Post Thanks / Like
    Mentioned
    471 Post(s)
    Tagged
    47 Thread(s)

    Default Re: VBA Code Add Condition

    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
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •