Update the cell colour as red if the date on the cell belongs to current month

[Fresher]

Hello UiPath community,

I Have one business requirement, where I need to read specific column from excel file ( eg: column F - which is fixed) and row count is dynamic (eg : F1 to F(row count))

Now the requirement is I have to colour the cell as red, if the date in the cell belongs to current month.

I tried to use the read cell activity under the for each loop and used If condition to update the colour value, when it meets the condition and its working fine.

Now the problem is its taking too much of time to completed one file where the row count is more than 15,000.

Could someone share the VBA script as text file to achieve this.

1)sheet name remains constant
2)Column name remains constant but the range varies depends upon the row count
3)File Name varies

Hope points 2 and 3 has to be the variable I need to pass to VBA script.

Thanks in advance!!

[jack.chan]

@Fresher
can you upload a sample of the excel file, maybe like 10 rows

[Fresher]

Hi @jack.chan

Please find the attached sample file - I have made some dummy data and highlighted the current month value as red color
Book1.xlsx (10.1 KB)

[jack.chan]

put the below code in txt file eg vba.txt

then use excel application scope on your excel, inside invoke vba and pass vba.txt

the only thing you have to change is the fileName (currently its Book1.xlsx)

Function HighlightCurrentMonthRed()
    ActiveWorkbook.Sheets("Sheet1").Activate
    Dim colLetter As String
    
    colLetter = FindColumnLetterOfTextInRow("ColF", "1")
    
    Dim colRange As Range
    Dim lastRow As Long
    
    lastRow = Range(colLetter & CStr(Rows.CountLarge)).End(xlUp).Row
    
    Set colRange = Range(colLetter & "2" & ":" & colLetter & CStr(lastRow))
    
    Dim r As Range
    For Each r In colRange
        If Month(r.Value) = Month(Now) Then
            r.Interior.Color = vbRed
        End If
    Next r
    
    ActiveWorkbook.Save
End Function

Public Function FindColumnLetterOfTextInRow(strToFind As String, inputRow As String) As String
    Dim ResRange As Range, rangeToFind As Range
    Set rangeToFind = Range("A" & inputRow & ":" & Replace(Range(ConvertNumberToLetter(Columns.Count) & inputRow).End(xlToLeft).Address, "$", ""))
    
    If rangeToFind.Count = 1 Then
        Debug.Print "Range empty"
        Err.Raise Number:=vbOjectError + 513, Description:="Cant find text " & strToFind & " in row = " & inputRow
    End If
    
    rangeToFind.Select
    Debug.Print rangeToFind.Address
    Set ResRange = rangeToFind.Find(What:=strToFind, LookIn:=xlValues)
    If ResRange Is Nothing Then
        Err.Raise Number:=vbOjectError + 513, Description:="Cant find text " & strToFind & " in row = " & inputRow
    Else
        Debug.Print ResRange.Address
        FindColumnLetterOfTextInRow = ConvertNumberToLetter(ResRange.Column)
    End If
    
End Function

Public Function ConvertNumberToLetter(columnNumber As Integer)
    Dim letter
    letter = Split(Cells(1, columnNumber).Address, "$")(1)
    ConvertNumberToLetter = letter
End Function

[Fresher]

@jack.chan - Thanks for your immediate assistance!! Its suits my requirement…
Thanks a lot again