Solved Excel how to conditional format with a macro

Microsoft Office excel 2007 - upgrade
August 28, 2010 at 13:10:12
Specs: Windows XP
How can I write a macro so that it will conditionally format the cells of three different columns?
I would like to understand how to write the formula so that it runs until it sees a blank row for those columns that I want to condition. I receive a regular report for each of my customers but the number of rows will vary based on the amount of business that particular customer has with us.

Each report has dates that are important in Columns L,M, & N. I want to use the following formulas to conditionally format the columns M&N yellow for dates prior than today, and red for dates after today. I want to use the same highlighting scheme on column L except this column is highlighted if the date is 122 days away from today. If it is more than 122 days from today, it will format in red.

=(M8-Today())>1 make this red (do the same for column N)
=(M8-Today())<1 make this yellow

Column L make its own

=(L8-Today())-122<1 make yellow
=(L8-Today())-122>1 make red


See More: Excel how to conditional format with a macro

Report •


✔ Best Answer
September 6, 2010 at 06:57:56
Hi,

As you need to apply CF to different worksheets, I suggest the following approach.
Create a new workbook and save it as a Macro-enabled Excel workbook (ApplyCFs.xlsm)
Add a command button to Sheet1 in this workbook (instructions below)
The macro will be run when the button is clicked.

When setup, the process will be to open the workbook that needs the CFs applied.
Then open the ApplyCFs.xlsm workbook
Click the button.
An input box will open, asking for the name of the workbook that needs the CF applied to it.
(If it's not open or the name is wrong, the macro closes after a warning/information message).
Then a second input box opens, asking for the name of the worksheet.
(If the name is not present/entered incorrectly, there is a warning/information box and the worksheet name input box is displayed again. Clicking 'Cancel' on this input box closes the macro).

At this point, with the correct workbook name and worksheet name, the CFs are applied to data in columns L, M & N, starting at Row 8 and going to the end of the rows of data (based on the last row in column L that contains data).

To add the button & associated macro to the ApplyCFs.xlsm workbook, follow these steps:
In worksheet "Sheet1" - From the Ribbon select Developer (If it's not visible go to the Office Button, select Excel options at the bottom and select the Popular tab and check the 'Show Developer tab in the Ribbon' box)

In Developer - Controls select Insert and choose the button icon.
Draw the button on the worksheet
In the 'Assign Macro' dialog box select 'New'

In the code window that opens enter this:

Option Explicit

' create a constant consisting of a pair of double quotes
' makes it easier to create the CF formulas that need ""
' for example =IF(L8="",FALSE,IF(L8>TODAY()+121,TRUE,FALSE))
Private Const DBLQT As String = """"""

Sub Button1_Click()
Dim strName As String
Dim wbEach As Workbook
Dim strSheet As String
Dim wsEach As Worksheet
Dim blnFound As Boolean
Dim objCF As FormatCondition
Dim rngCell As Range
Dim rngEnd As Range
Dim rngToCF As Range
Dim strAddr As String
Dim strFmla As String
Dim varClr As Variant
Dim dblFillClrLess As Double
Dim dblFillClrMore As Double

'set fill colors
'Less is for < formulas
'More is for > formulas
dblFillClrLess = 7204607
dblFillClrMore = 5065193

'get name of Workbook to act on
strName = InputBox("Enter name of workbook to apply CF to:" & vbCrLf _
                & "include file type such as .xls or .xlsx" & _
                "The document must already be open in Excel", _
                "Apply Conditional Formatting to Columns L, M & N")

'if Cancel or nothing entered, exit the sub.
If strName = "" Then Exit Sub

'test if workbook is open
blnFound = False
For Each wbEach In Application.Workbooks()
    If wbEach.Name = strName Then
        blnFound = True
    End If
    If blnFound = True Then Exit For
Next wbEach
If blnFound = False Then
    MsgBox "The workbook you named was not open" & vbCrLf _
            & "Ensure that the workbook is open and" & vbCrLf _
            & "make sure to enter the full name including extension"
    Exit Sub
End If

WsName:
'now get worksheet name
strSheet = InputBox("Enter name of worksheet to apply CF to:" & vbCrLf _
                & "Apply Conditional Formatting to Columns L, M & N")

'test if worksheet is present
blnFound = False
For Each wsEach In Workbooks(strName).Worksheets()
    If wsEach.Name = strSheet Then
        blnFound = True
    End If
    If blnFound = True Then Exit For
Next wsEach

If blnFound = False Then
    MsgBox "Worksheet name not found - please enter it again"
    GoTo WsName
End If

With Workbooks(strName).Worksheets(strSheet)
    ' Find end of data in column L
    Set rngEnd = .Range("L" & CStr(Application.Rows.Count)).End(xlUp)
    ' create range to CF - data starts in row 8 in column L
    Set rngToCF = .Range("L8:" & rngEnd.Address)
    
    ' loop through range
    '(rngCell represents each cell in the range in turn)
    ' offset(row, column) is used to access columns M & N
    ' the base range is column L, so .Offset(0, 1) is column M
    For Each rngCell In rngToCF
        '*******************
        'CF cell in column L
        'create cell address
        strAddr = rngCell.Address
        'create the first CF formula
        strFmla = "=IF(" & strAddr & "=" _
                    & DBLQT & ",FALSE,IF(" _
                    & strAddr & ">TODAY()+121,TRUE,FALSE))"
        'add the first CF
        Set objCF = rngCell.FormatConditions.Add _
                    (Type:=xlExpression, _
                    Formula1:=strFmla)
        'set formats for first CF
        With objCF
            .Interior.Color = dblFillClrMore
        End With
        'create the second CF formula
        strFmla = "=IF(" & strAddr & "=" _
                    & DBLQT & ",FALSE,IF(" _
                    & strAddr & "<TODAY()-121,TRUE,FALSE))"
        'add the second CF
        Set objCF = rngCell.FormatConditions.Add _
                    (Type:=xlExpression, _
                    Formula1:=strFmla)
        'set formats for second CF
        With objCF
            .Interior.Color = dblFillClrLess
        End With
        '*******************
        'CF cell in column M
        'create cell address
        strAddr = rngCell.Offset(0, 1).Address
        'create the first CF formula
        strFmla = "=IF(" & strAddr & "=" _
                    & DBLQT & ",FALSE,IF(" _
                    & strAddr & ">TODAY(),TRUE,FALSE))"
        'add the first CF
        Set objCF = rngCell.Offset(0, 1).FormatConditions.Add _
                    (Type:=xlExpression, _
                    Formula1:=strFmla)
        'set formats for first CF
        With objCF
            .Interior.Color = dblFillClrMore
        End With
        'create the second CF formula
        strFmla = "=IF(" & strAddr & "=" _
                    & DBLQT & ",FALSE,IF(" _
                    & strAddr & "<TODAY(),TRUE,FALSE))"
        'add the second CF
        Set objCF = rngCell.Offset(0, 1).FormatConditions.Add _
                    (Type:=xlExpression, _
                    Formula1:=strFmla)
        'set formats for second CF
        With objCF
            .Interior.Color = dblFillClrLess
        End With
        '*******************
        'CF cell in column N
        'create cell address
        strAddr = rngCell.Offset(0, 2).Address
        'create the first CF formula
        strFmla = "=IF(" & strAddr & "=" _
                    & DBLQT & ",FALSE,IF(" _
                    & strAddr & ">TODAY(),TRUE,FALSE))"
        'add the first CF
        Set objCF = rngCell.Offset(0, 2).FormatConditions.Add _
                    (Type:=xlExpression, _
                    Formula1:=strFmla)
        'set formats for first CF
        With objCF
            .Interior.Color = dblFillClrMore
        End With
        'create the second CF formula
        strFmla = "=IF(" & strAddr & "=" _
                    & DBLQT & ",FALSE,IF(" _
                    & strAddr & "<TODAY(),TRUE,FALSE))"
        'add the second CF
        Set objCF = rngCell.Offset(0, 2).FormatConditions.Add _
                    (Type:=xlExpression, _
                    Formula1:=strFmla)
        'set formats for second CF
        With objCF
            .Interior.Color = dblFillClrLess
        End With
    Next rngCell
    
    'set all the cells in the CF range to the same date format
    rngToCF.Resize(rngToCF.Rows.Count, 3).NumberFormat = "dd-mmm-yy"
End With
End Sub


Sub getclr()
MsgBox "The color in Cell A1 is: " & _
    ActiveSheet.Range("A1").Interior.Color
End Sub

Note that Sub Button1_Click() and End sub will already be present, so don't duplicate them. Option explicit and the Private Const lines go before Sub Button1_Click().

The Sub getclr() to End Sub lines go after the End Sub that goes with Button_Click.

Click Save from the Visual Basic Menu.

Alt+f11 takes you back to the main Excel window.

Right click the button and Edit the name to something meaningful

As changes made by Macros cannot be undone with the Undo button, test this macro on a copy of your data. Always make a backup of your Workbook before running this macro. This code has only been tested on sample data, and it has not been tested in your environment, so test it on copies of your data to ensure that it works 'as expected'

After selecting any cell on Sheet1, the new command button should now respond to a click and run the macro.

I have included two lines where the conditional format colors are applied:
'set fill colors
'Less is for < formulas
'More is for > formulas
dblFillClrLess = 7204607
dblFillClrMore = 5065193

As the color numbers are not easy to relate to actual colors, there is a small macro that allows you to set a normal fill color in cell A1 and the macro tells you what the color number is. You can then use that number in the CF macro.
Change the color in cell A1 in ApplyCF's.xlsm Sheet1 and then in the Visual Basic window select the macro name Sub getclr() and then click the f5 function key. The color number for cell A1 will be displayed.

An alternative is to change the two color lines to:
dblFillClrLess = RGB(250, 20, 20)
dblFillClrMore = RGB(250, 220, 0)
and select red, green & blue values between 0 and 255.

Note, that there is a line near the end of the macro that sets the date formats in the CF range.
You can either set your preferred date format on this line:
'set all the cells in the CF range to the same date format
rngToCF.Resize(rngToCF.Rows.Count, 3).NumberFormat = "dd-mmm-yy"
or remove the line altogether.

Note that this macro does not remove CFs. If you want to re-run it, say on a test workbook, to adjust the colors or the formulas, you will need to select the cells and then use Clear - Clear formats, before running the macro again.
As 'Clear formats' also removes date formats, retaining this line, at least for testing is of value.

Regards



#1
September 3, 2010 at 12:12:47
Hi,

There are several ways to go through a column of cells until you find an empty cell.

One is simply to test the cell and if it's not empty increment a row counter and test again:

Sub test()
Dim n As Double
'set row counter to first row to test
n = 1
Do While ActiveSheet.Range("A" & CStr(n)).Value <> ""
'increment row counter as long as the cell in column A
'isn't empty
' *********
' add code to process each cell
' *********
'increment row counter
n = n + 1
Loop
'display address of first empty cell
MsgBox ActiveSheet.Range("A" & CStr(n)).Address
End Sub

Another way is to use End to find the last used cell in a column or row.
Use it to setup a range of cells and then use VBA's method of going through all objects in a collection - in this case a collection of cells in a Range object.

Sub test()
Dim rngEnd As Range
Dim rngCell As Range

'find last used cell in column A
Set rngEnd = Range("A" & CStr(Application.Rows.Count)).End(xlUp)
'loop through a range starting at cell A1
'and ending with the last cell in column A containing data
For Each rngCell In ActiveSheet.Range("A1", rngEnd.Address)
    ' *********
    ' add code to process each cell
    ' rngCell will be each cell in the selected range
    ' in column A in turn
    ' *********
Next rngCell
End Sub

This can be useful when you want to process cells down to the last used cell, but have empty cells within the range (in this case the range of cells in column A.
In each loop, rngCell can be used to access or change the cell in column A
e.g., rngCell.Value = rngCell.Value *2

In both examples the OFFSET function can be used to access cells in adjacent columns:
.Offset(row_offset, column_offset).Value
e.g. if rngCell is cell A10, then rngCell.Offset(0,1) is cell B10.

Adding conditional formatting to a cell can be done as follows:

    'add new CF
    Set objCF = rngCell.FormatConditions.Add _
                (Type:=xlExpression, _
                Formula1:="=IF(A1=4,TRUE,FALSE)")
    'set formats for new CF
    With objCF
        .Font.ColorIndex = 26
        .Interior.ColorIndex = 19
    End With

In the Excel 2010 Help file for the 'FormatConditions.Add' Method it states under 'Remarks':
"You cannot define more than three conditional formats for a range"

This does not appear to be correct, as I was able to add five CF's - I didn't try any more.

I suggest you add the CFs manually to start with, just to test that they work 'as expected' before using them in the macro. At least then, if it doesn't work, the problem isn't the CF formula.

Hope this helps get you started.

If you have specific issues, please post again, and include the code that is giving problems.

Regards


Report •

#2
September 5, 2010 at 08:10:20
Thank you for taking the time to respond. I have never written a macro so I am not clear how this works. I am not sure if both the macro codes you typed can be entered into a single macro or if two different macros are required.

My spreadsheet reports are always the same in that the data starts on row 8, and the three columns that I want to Conditional format are L, M, and N.

Thanks again!


Report •

#3
September 5, 2010 at 10:18:19
Hi,

I was just giving you code snippets that you could use - as it appeared that you wanted to write the macro.

I will have a go and see if I can produce a finished macro - complete with instructions on loading and running it.

May be a few days before I get to it.

Regards


Report •

Related Solutions

#4
September 5, 2010 at 11:14:40
Hi,

When you say I receive a regular report for each of my customers but the number of rows will vary, does this mean that you want the conditional formatting applied to each of these workbooks when you receive them,
or do you copy and paste the data into the same workbook/worksheet each time.

If you copy and paste into the same worksheet in the same workbook each time, there is no need for a macro, as you only need to do a one-time CF.

Regards


Report •

#5
September 5, 2010 at 11:28:52
Thank you. I really appreciate it. I think I will pick up on how it works once I see your code. Have a great holiday!

Report •

#6
September 5, 2010 at 13:00:54
I want the conditional formatting applied to each of these workbooks when I receive them. Each report starts with the data that I want for format on line 8 of the report, and columns L,M, and N.

Each report has dates that are important in Columns L,M, & N. I want to use the following formulas to conditionally format the columns M&N yellow for dates prior than today, and red for dates after today. I want to use the same highlighting scheme on column L except this column is highlighted if the date is 122 days away from today. If it is more than 122 days from today, it will format in red.

=(M8-Today())>1 make this red (do the same for column N)
=(M8-Today())<1 make this yellow

Column L make its own

=(L8-Today())-122<1 make yellow
=(L8-Today())-122>1 make red

Thank you.


Report •

#7
September 6, 2010 at 06:57:56
✔ Best Answer
Hi,

As you need to apply CF to different worksheets, I suggest the following approach.
Create a new workbook and save it as a Macro-enabled Excel workbook (ApplyCFs.xlsm)
Add a command button to Sheet1 in this workbook (instructions below)
The macro will be run when the button is clicked.

When setup, the process will be to open the workbook that needs the CFs applied.
Then open the ApplyCFs.xlsm workbook
Click the button.
An input box will open, asking for the name of the workbook that needs the CF applied to it.
(If it's not open or the name is wrong, the macro closes after a warning/information message).
Then a second input box opens, asking for the name of the worksheet.
(If the name is not present/entered incorrectly, there is a warning/information box and the worksheet name input box is displayed again. Clicking 'Cancel' on this input box closes the macro).

At this point, with the correct workbook name and worksheet name, the CFs are applied to data in columns L, M & N, starting at Row 8 and going to the end of the rows of data (based on the last row in column L that contains data).

To add the button & associated macro to the ApplyCFs.xlsm workbook, follow these steps:
In worksheet "Sheet1" - From the Ribbon select Developer (If it's not visible go to the Office Button, select Excel options at the bottom and select the Popular tab and check the 'Show Developer tab in the Ribbon' box)

In Developer - Controls select Insert and choose the button icon.
Draw the button on the worksheet
In the 'Assign Macro' dialog box select 'New'

In the code window that opens enter this:

Option Explicit

' create a constant consisting of a pair of double quotes
' makes it easier to create the CF formulas that need ""
' for example =IF(L8="",FALSE,IF(L8>TODAY()+121,TRUE,FALSE))
Private Const DBLQT As String = """"""

Sub Button1_Click()
Dim strName As String
Dim wbEach As Workbook
Dim strSheet As String
Dim wsEach As Worksheet
Dim blnFound As Boolean
Dim objCF As FormatCondition
Dim rngCell As Range
Dim rngEnd As Range
Dim rngToCF As Range
Dim strAddr As String
Dim strFmla As String
Dim varClr As Variant
Dim dblFillClrLess As Double
Dim dblFillClrMore As Double

'set fill colors
'Less is for < formulas
'More is for > formulas
dblFillClrLess = 7204607
dblFillClrMore = 5065193

'get name of Workbook to act on
strName = InputBox("Enter name of workbook to apply CF to:" & vbCrLf _
                & "include file type such as .xls or .xlsx" & _
                "The document must already be open in Excel", _
                "Apply Conditional Formatting to Columns L, M & N")

'if Cancel or nothing entered, exit the sub.
If strName = "" Then Exit Sub

'test if workbook is open
blnFound = False
For Each wbEach In Application.Workbooks()
    If wbEach.Name = strName Then
        blnFound = True
    End If
    If blnFound = True Then Exit For
Next wbEach
If blnFound = False Then
    MsgBox "The workbook you named was not open" & vbCrLf _
            & "Ensure that the workbook is open and" & vbCrLf _
            & "make sure to enter the full name including extension"
    Exit Sub
End If

WsName:
'now get worksheet name
strSheet = InputBox("Enter name of worksheet to apply CF to:" & vbCrLf _
                & "Apply Conditional Formatting to Columns L, M & N")

'test if worksheet is present
blnFound = False
For Each wsEach In Workbooks(strName).Worksheets()
    If wsEach.Name = strSheet Then
        blnFound = True
    End If
    If blnFound = True Then Exit For
Next wsEach

If blnFound = False Then
    MsgBox "Worksheet name not found - please enter it again"
    GoTo WsName
End If

With Workbooks(strName).Worksheets(strSheet)
    ' Find end of data in column L
    Set rngEnd = .Range("L" & CStr(Application.Rows.Count)).End(xlUp)
    ' create range to CF - data starts in row 8 in column L
    Set rngToCF = .Range("L8:" & rngEnd.Address)
    
    ' loop through range
    '(rngCell represents each cell in the range in turn)
    ' offset(row, column) is used to access columns M & N
    ' the base range is column L, so .Offset(0, 1) is column M
    For Each rngCell In rngToCF
        '*******************
        'CF cell in column L
        'create cell address
        strAddr = rngCell.Address
        'create the first CF formula
        strFmla = "=IF(" & strAddr & "=" _
                    & DBLQT & ",FALSE,IF(" _
                    & strAddr & ">TODAY()+121,TRUE,FALSE))"
        'add the first CF
        Set objCF = rngCell.FormatConditions.Add _
                    (Type:=xlExpression, _
                    Formula1:=strFmla)
        'set formats for first CF
        With objCF
            .Interior.Color = dblFillClrMore
        End With
        'create the second CF formula
        strFmla = "=IF(" & strAddr & "=" _
                    & DBLQT & ",FALSE,IF(" _
                    & strAddr & "<TODAY()-121,TRUE,FALSE))"
        'add the second CF
        Set objCF = rngCell.FormatConditions.Add _
                    (Type:=xlExpression, _
                    Formula1:=strFmla)
        'set formats for second CF
        With objCF
            .Interior.Color = dblFillClrLess
        End With
        '*******************
        'CF cell in column M
        'create cell address
        strAddr = rngCell.Offset(0, 1).Address
        'create the first CF formula
        strFmla = "=IF(" & strAddr & "=" _
                    & DBLQT & ",FALSE,IF(" _
                    & strAddr & ">TODAY(),TRUE,FALSE))"
        'add the first CF
        Set objCF = rngCell.Offset(0, 1).FormatConditions.Add _
                    (Type:=xlExpression, _
                    Formula1:=strFmla)
        'set formats for first CF
        With objCF
            .Interior.Color = dblFillClrMore
        End With
        'create the second CF formula
        strFmla = "=IF(" & strAddr & "=" _
                    & DBLQT & ",FALSE,IF(" _
                    & strAddr & "<TODAY(),TRUE,FALSE))"
        'add the second CF
        Set objCF = rngCell.Offset(0, 1).FormatConditions.Add _
                    (Type:=xlExpression, _
                    Formula1:=strFmla)
        'set formats for second CF
        With objCF
            .Interior.Color = dblFillClrLess
        End With
        '*******************
        'CF cell in column N
        'create cell address
        strAddr = rngCell.Offset(0, 2).Address
        'create the first CF formula
        strFmla = "=IF(" & strAddr & "=" _
                    & DBLQT & ",FALSE,IF(" _
                    & strAddr & ">TODAY(),TRUE,FALSE))"
        'add the first CF
        Set objCF = rngCell.Offset(0, 2).FormatConditions.Add _
                    (Type:=xlExpression, _
                    Formula1:=strFmla)
        'set formats for first CF
        With objCF
            .Interior.Color = dblFillClrMore
        End With
        'create the second CF formula
        strFmla = "=IF(" & strAddr & "=" _
                    & DBLQT & ",FALSE,IF(" _
                    & strAddr & "<TODAY(),TRUE,FALSE))"
        'add the second CF
        Set objCF = rngCell.Offset(0, 2).FormatConditions.Add _
                    (Type:=xlExpression, _
                    Formula1:=strFmla)
        'set formats for second CF
        With objCF
            .Interior.Color = dblFillClrLess
        End With
    Next rngCell
    
    'set all the cells in the CF range to the same date format
    rngToCF.Resize(rngToCF.Rows.Count, 3).NumberFormat = "dd-mmm-yy"
End With
End Sub


Sub getclr()
MsgBox "The color in Cell A1 is: " & _
    ActiveSheet.Range("A1").Interior.Color
End Sub

Note that Sub Button1_Click() and End sub will already be present, so don't duplicate them. Option explicit and the Private Const lines go before Sub Button1_Click().

The Sub getclr() to End Sub lines go after the End Sub that goes with Button_Click.

Click Save from the Visual Basic Menu.

Alt+f11 takes you back to the main Excel window.

Right click the button and Edit the name to something meaningful

As changes made by Macros cannot be undone with the Undo button, test this macro on a copy of your data. Always make a backup of your Workbook before running this macro. This code has only been tested on sample data, and it has not been tested in your environment, so test it on copies of your data to ensure that it works 'as expected'

After selecting any cell on Sheet1, the new command button should now respond to a click and run the macro.

I have included two lines where the conditional format colors are applied:
'set fill colors
'Less is for < formulas
'More is for > formulas
dblFillClrLess = 7204607
dblFillClrMore = 5065193

As the color numbers are not easy to relate to actual colors, there is a small macro that allows you to set a normal fill color in cell A1 and the macro tells you what the color number is. You can then use that number in the CF macro.
Change the color in cell A1 in ApplyCF's.xlsm Sheet1 and then in the Visual Basic window select the macro name Sub getclr() and then click the f5 function key. The color number for cell A1 will be displayed.

An alternative is to change the two color lines to:
dblFillClrLess = RGB(250, 20, 20)
dblFillClrMore = RGB(250, 220, 0)
and select red, green & blue values between 0 and 255.

Note, that there is a line near the end of the macro that sets the date formats in the CF range.
You can either set your preferred date format on this line:
'set all the cells in the CF range to the same date format
rngToCF.Resize(rngToCF.Rows.Count, 3).NumberFormat = "dd-mmm-yy"
or remove the line altogether.

Note that this macro does not remove CFs. If you want to re-run it, say on a test workbook, to adjust the colors or the formulas, you will need to select the cells and then use Clear - Clear formats, before running the macro again.
As 'Clear formats' also removes date formats, retaining this line, at least for testing is of value.

Regards


Report •

#8
September 6, 2010 at 07:56:45
Thank you so much for your hard work. I can try to create a new workbook but it will not be the best approach. One reason is that each report has multiple tabs--although I am interested in using CF in one main tab. Each spreadsheet report includes a summary, a 3 month average report of customer usage, then a data usage tab, then a messaging usage tab, then a 3 month break down, then a month by month report tab (3 additional tabs). So if I create a master workbook tab, I will spend too much time cutting and pasting the rest of the tabs into the workbook (and when I do this, I usually do not keep all the formatting --especially print formatting).

The other concern I have is that these reports have confidential customer information. I do not want to risk accidently sending the wrong customers information because I did not transfer information properly to the control spreadsheet.

Do these concerns make sense? That is why I would like to just establish a macro that can be run for whatever customer spreadsheet I open.

Thank you so much for your willness to help and the time you have invested. It is much appreciated!


Report •

#9
September 6, 2010 at 09:27:20
I tried to use the macro button and received the following error:
runtime error '1004':
Application-defined or Oject-defined error

'when I click debug, the following is hightlighted: Set rngEnd = .Range("L" & CStr(Application.Rows.Count)).End(xlUp)

'Here is an example of some of my column LM&N data from one worksheet:

Current Contract End Date Equipment Upgrade Eligibility Date New Every Two Date
Out of Contract 01/02/2009 01/02/2009
Out of Contract 01/02/2009 01/02/2009
Out of Contract 01/02/2009 01/02/2009
Out of Contract 01/02/2009 01/02/2009
Out of Contract 01/02/2009 01/02/2009
Out of Contract 12/23/2009 Not Eligible

Any ideas? Could it be that sometimes there is not a date, but the phrase out of contract in column L ?


Report •

#10
September 6, 2010 at 09:39:49
Hi,

No it's not an issue of having "Out of Contract" etc. instead of a date.

Did you enter the workbook name and worksheet names OK when the macro ran.

When the macro stops at that line, use the mouse to hover the cursor over strName and strSheet in the line just above. This will reveal their values. Do the values exactly match the name of the workbook and the worksheet name.

Regards


Report •

#11
September 6, 2010 at 10:04:59
Hi,

Responding to response #8:

The new worksheet is not intended for you to copy any data into it - it is just a 'holder' for the macro.

The macro will be run from that new workbook, but it will act directly on any workbook that you have opened - you just have to tell it the name of the workbook and of course which worksheet (tab), to add the CFs to.

Regards


Report •

#12
September 6, 2010 at 12:21:06
Yes it looks like I am entering the file name.xls correctly and the worksheet name correctly.

I don't know if this will help but this is what I entered in for the Macro:

Option Explicit

' create a constant consisting of a pair of double quotes
' makes it easier to create the CF formulas that need ""
' for example =IF(L8="",FALSE,IF(L8>TODAY()+121,TRUE,FALSE))
Private Const DBLQT As String = """"""

Sub Button1_Click()
Dim strName As String
Dim wbEach As Workbook
Dim strSheet As String
Dim wsEach As Worksheet
Dim blnFound As Boolean
Dim objCF As FormatCondition
Dim rngCell As Range
Dim rngEnd As Range
Dim rngToCF As Range
Dim strAddr As String
Dim strFmla As String
Dim varClr As Variant
Dim dblFillClrLess As Double
Dim dblFillClrMore As Double

'set fill colors
'Less is for < formulas
'More is for > formulas
dblFillClrLess = 7204607
dblFillClrMore = 5065193

'get name of Workbook to act on
strName = InputBox("Enter name of workbook to apply CF to:" & vbCrLf _
& "include file type such as .xls or .xlsx" & _
"The document must already be open in Excel", _
"Apply Conditional Formatting to Columns L, M & N")

'if Cancel or nothing entered, exit the sub.
If strName = "" Then Exit Sub

'test if workbook is open
blnFound = False
For Each wbEach In Application.Workbooks()
If wbEach.Name = strName Then
blnFound = True
End If
If blnFound = True Then Exit For
Next wbEach
If blnFound = False Then
MsgBox "The workbook you named was not open" & vbCrLf _
& "Ensure that the workbook is open and" & vbCrLf _
& "make sure to enter the full name including extension"
Exit Sub
End If

WsName:
'now get worksheet name
strSheet = InputBox("Enter name of worksheet to apply CF to:" & vbCrLf _
& "Apply Conditional Formatting to Columns L, M & N")

'test if worksheet is present
blnFound = False
For Each wsEach In Workbooks(strName).Worksheets()
If wsEach.Name = strSheet Then
blnFound = True
End If
If blnFound = True Then Exit For
Next wsEach

If blnFound = False Then
MsgBox "Worksheet name not found - please enter it again"
GoTo WsName
End If

With Workbooks(strName).Worksheets(strSheet)
' Find end of data in column L
Set rngEnd = .Range("L" & CStr(Application.Rows.Count)).End(xlUp)
' create range to CF - data starts in row 8 in column L
Set rngToCF = .Range("L8:" & rngEnd.Address)

' loop through range
'(rngCell represents each cell in the range in turn)
' offset(row, column) is used to access columns M & N
' the base range is column L, so .Offset(0, 1) is column M
For Each rngCell In rngToCF
'*******************
'CF cell in column L
'create cell address
strAddr = rngCell.Address
'create the first CF formula
strFmla = "=IF(" & strAddr & "=" _
& DBLQT & ",FALSE,IF(" _
& strAddr & ">TODAY()+121,TRUE,FALSE))"
'add the first CF
Set objCF = rngCell.FormatConditions.Add _
(Type:=xlExpression, _
Formula1:=strFmla)
'set formats for first CF
With objCF
.Interior.Color = dblFillClrMore
End With
'create the second CF formula
strFmla = "=IF(" & strAddr & "=" _
& DBLQT & ",FALSE,IF(" _
& strAddr & "<TODAY()-121,TRUE,FALSE))"
'add the second CF
Set objCF = rngCell.FormatConditions.Add _
(Type:=xlExpression, _
Formula1:=strFmla)
'set formats for second CF
With objCF
.Interior.Color = dblFillClrLess
End With
'*******************
'CF cell in column M
'create cell address
strAddr = rngCell.Offset(0, 1).Address
'create the first CF formula
strFmla = "=IF(" & strAddr & "=" _
& DBLQT & ",FALSE,IF(" _
& strAddr & ">TODAY(),TRUE,FALSE))"
'add the first CF
Set objCF = rngCell.Offset(0, 1).FormatConditions.Add _
(Type:=xlExpression, _
Formula1:=strFmla)
'set formats for first CF
With objCF
.Interior.Color = dblFillClrMore
End With
'create the second CF formula
strFmla = "=IF(" & strAddr & "=" _
& DBLQT & ",FALSE,IF(" _
& strAddr & "<TODAY(),TRUE,FALSE))"
'add the second CF
Set objCF = rngCell.Offset(0, 1).FormatConditions.Add _
(Type:=xlExpression, _
Formula1:=strFmla)
'set formats for second CF
With objCF
.Interior.Color = dblFillClrLess
End With
'*******************
'CF cell in column N
'create cell address
strAddr = rngCell.Offset(0, 2).Address
'create the first CF formula
strFmla = "=IF(" & strAddr & "=" _
& DBLQT & ",FALSE,IF(" _
& strAddr & ">TODAY(),TRUE,FALSE))"
'add the first CF
Set objCF = rngCell.Offset(0, 2).FormatConditions.Add _
(Type:=xlExpression, _
Formula1:=strFmla)
'set formats for first CF
With objCF
.Interior.Color = dblFillClrMore
End With
'create the second CF formula
strFmla = "=IF(" & strAddr & "=" _
& DBLQT & ",FALSE,IF(" _
& strAddr & "<TODAY(),TRUE,FALSE))"
'add the second CF
Set objCF = rngCell.Offset(0, 2).FormatConditions.Add _
(Type:=xlExpression, _
Formula1:=strFmla)
'set formats for second CF
With objCF
.Interior.Color = dblFillClrLess
End With
Next rngCell

'set all the cells in the CF range to the same date format
rngToCF.Resize(rngToCF.Rows.Count, 3).NumberFormat = "dd-mmm-yy"
End With
End Sub


Sub getclr()
MsgBox "The color in Cell A1 is: " & _
ActiveSheet.Range("A1").Interior.Color
End Sub

Thank you.


Report •

#13
September 6, 2010 at 15:57:46
Hi,

I copied the code you posted into Excel 2007 on a different PC, in a new workbook which I saved as "ApplyCFs.xlsm".

I then opened a new worksheet, entered some dates in columns L, M & N starting in row 8.
I then saved the workbook as "CFTest.xlsx"

I ran the macro from a button on Sheet1 in ApplyCFs.xlsm, and it successfully applied CFs to the cells in columns L, M & N, so I am a bit puzzled as to why the macro is not working.

Can you add this line which displays a message box and which should display the date or other text shown in Cell L8.

With Workbooks(strName).Worksheets(strSheet)
    MsgBox .Range("L8").Text
    ' Find end of data in column L

Let me know what happens when you run the macro again.

Regards


Report •

#14
September 6, 2010 at 18:58:38
I was not able to get it to work with the format that the report is delivered to me. I was able to cut and paste info from the worksheet into a new excel file, and then I can see it wants to format. I may need to retest since when it did format, my result was red color only--which may have been a function of the data vs the formatting code.

There must be an issue with any built in formatting used when the report is delivered to me. So without knowing those dynamics, we may not be able to make this thing work.


Report •

#15
September 7, 2010 at 04:40:06
Hi,

A couple of points:
1. You can look at the actual conditional format formulas applied to the worksheet in the normal way. Ribbon - Home - Styles - Conditional formatting - Manage Rules, then select each rule and click Edit to examine it.

2. If the cells are already formatted, the macro can be modified to add a step to clear existing formats.

Questions:
1. What 'format' is the file. You said: I was not able to get it to work with the format that the report is delivered to me.
Is it an xls or xlsx file or something else.

2. What built-in formatting are you thinking of. Is there any evidence that the cells are formatted - what happens if you look for existing conditional formats in the cells.

3. Do the cells in columns L, M & N on the source worksheets contain Excel-recognized dates.
Select a cell, say L8, right-click and select 'Format Cells...' and select the 'Number' tab and select number and 2 decimal places. Click OK.
Does the date in the cell change to a number such as 40428 (Excel's number for 07 September 2010).
If it remains as text, then the values in the cell have not been recognized by Excel as dates, and any test, including CF formulas, that test dates, will not work.
If this is the case it may be possible for the macro to convert the text to valid Excel-recognized dates.

Regards


Report •

Ask Question