MS Access 2010 change MS Excel cell background color using VBa

Posted on 2012-09-21
Last Modified: 2012-09-25
1. I need to open EXCEL work book.
2. compare  column L to date
3 . If less than set back ground color to red
4. if greater than set back ground color green
5. if equal set background color to yellow

I would like this to use VBA code.

Using: MS Access 2010 and MS Excel
Question by:newholyman
    LVL 10

    Expert Comment

    Try this:

    Sub ColourDateCell(ByVal strPathAndFileName As String, ByVal strSheetNameToCheck As String, dtmDate As Date)
        Dim appExcel        As Excel.Application
        Dim wbk             As Excel.Workbook
        Dim wks             As Excel.Worksheet
        Dim rngLastCell     As Excel.Range
        Dim lngFirstCell    As Long
        Dim lngLastCell     As Long
        Dim lngLoop         As Long
        Set appExcel = New Excel.Application
        Set wbk = appExcel.Workbooks.Open(strPathAndFileName)
        Set wks = wbk.Worksheets(strSheetNameToCheck)
        Set rngLastCell = wks.Cells(wks.Rows.Count, 12).End(xlUp)
        lngLastCell = rngLastCell.Row            ' Get the row number of last cell
        lngFirstCell = 1                        ' Assuming first cell to be checked is in row 1
        wks.Cells(1, 1).Select                  ' Selct first cell on worksheet
        ' Loop through range of cells and colour accordingly
        For lngLoop = lngFirstCell To lngLastCell
            ' Is it a date?
            If IsDate(wks.Cells(lngLoop, 12)) Then
                Select Case wks.Cells(lngLoop, 12)
                    Case Is > dtmDate
                        wks.Cells(lngLoop, 12).Interior.ColorIndex = 4     ' Green
                    Case Is < dtmDate
                        wks.Cells(lngLoop, 12).Interior.ColorIndex = 3     ' Red
                    Case dtmDate
                        wks.Cells(lngLoop, 12).Interior.ColorIndex = 6     ' Yellow
                End Select
            End If
        Next lngLoop
        Set wks = Nothing
        Set wbk = Nothing
        Set appExcel = Nothing
    End Sub

    Open in new window


    Author Comment

    I need to compare to  a date mm/dd/yy on form.

    wrk_date =09/22/12
    if wks.cells > wrk_date then
     change  color grenn
    end if
    LVL 10

    Expert Comment

    No problem.  The procedure I wrote accepts date as a parameter, so when you open your form in Access and select your date, pass the date you selected as a paramter to the procedure, along with the path/name of your workbook, and the name of the worksheet.

    Author Comment

    In addition the column 12 not  column one
    LVL 10

    Accepted Solution

    Yup...  my code is looking at column 12...  column L?

    Have attached a working example for you to try.

    Author Comment

    I'm sorry, I only want to check column L  to a date field and only color coumn L

    Thank you

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    Highfive Gives IT Their Time Back

    Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

    The canonical version of this article is on my web site here: A companion presentation is available here:
    This collection of functions covers all the normal rounding methods of just about any numeric value.
    Viewers will learn the different options available in the Backstage view in Excel 2013.
    The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…

    758 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    14 Experts available now in Live!

    Get 1:1 Help Now