CODEWITHSUNDEEP
vbaexcel
stack mark
stack mark

Reputation: 101

Identifying days based on date values in VBA

I have dates along with time under Col K and certain values (numbers) corresponding to these days under Col M.

I have a code that changes the color of these values if they are greater than 1 and if they have a text "waiting" in col P.

What I don't know to do is, add the below condition into this code:

1.I want to identify if these days belongs to a Sunday.

2.If Yes, then I want to check if the Sunday hours (lets say the date/time format is "15/1/2016 17:00" so the remaining time left for Sunday to get over is 0.3 day) subtracted from the number in Col M and if still the number is >1, then it should be highlighted in "Red".

3.The subtraction should not affect or appear in the current sheet.

I tried the below code but I'm not sure where I'm making the mistake as there are no result.

Sub Datefilter()
Dim r As Long
Dim m As Long

On Error GoTo ExitHere:
m = Range("M:P").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Application.ScreenUpdating = False
   For r = 1 To m
      remainingDay = 0

       If Weekday(Range("K" & r)) = 1 Then

              remainingDay = Round((24 - Format(TimeValue(Range("K" & r)), "h")) / 24, 1)

               End If
      If Range("P" & r) = "*waiting*" Then
            If Range("M" & r) - remainingDay >= 1 Then
                  Range("M" & r).Cells.Font.ColorIndex = 3
                  Else
                 Range("M" & r).Cells.Font.ColorIndex = 0
               End If
               End If
      Next r
      ExitHere:
      Application.ScreenUpdating = True
End Sub

Upvotes: 2

Views: 982

Answers (2)

Jonathan
Jonathan

Reputation: 1015

I feel this would be much easier with Excel's built-in functions and some helper columns.

(1) Use the WEEKDAY() function to get the day of the week. Then use a simple comparison to check if it is Sunday.

(2) Dates are stored as the amount of time expired since 0th January 1900, with partial dates as fractions. Therefore, to return the time, simply take the rounded bit of the date from the date: =A1-ROUNDDOWN(A1,0)

(3) Use conditional formatting to check if the cell is < 1 and then turn it red.

Let me know if you would like a screenshot of an example.

Upvotes: 4

PSotor
PSotor

Reputation: 346

Try this:

Sub Datefilter()

Dim r, lastrow, remainingDay As Long

'On Error GoTo ExitHere: ' I recommend to delete this

lastrow = Range("M:P").Cells(Rows.Count, "A").End(xlUp).Row

Application.ScreenUpdating = False

   For r = 1 To lastrow
      remainingDay = 0

        If Weekday(Range("K" & r).Value, vbSunday) = 1 Then
                remainingDay = Round((24 - Format(TimeValue(Range("K" & r)), "h")) / 24, 1)

             If InStr(1, Range("P" & r).Text, "waiting", vbTextCompare) > 0 Then

                 If Range("M" & r) - remainingDay >= 1 Then
                     Range("M" & r).Cells.Font.ColorIndex = 3
                 Else
                     Range("M" & r).Cells.Font.ColorIndex = 0
                 End If
             End If
        End If
    Next r
'ExitHere: ' I recommend to delete this
      Application.ScreenUpdating = True
End Sub

Upvotes: 0

Related Questions