ANYTIME NEEDED MACRO FOR CONDITIONAL FORMATTING

T

Tree

EXCEL 2007
Jacob helped me do this CF for a particular worksheet and it works great,
but I want to be able to "call" this into any worksheet whenever I need it..
we Use the Data Tab to run subtotals all the time - especially when we export
data from Quickbooks to modify reports in Excel..
I tried to Record the Macro in the Personal.xlb but that didn't go so well -
so any assistance from the experts would be so greatly appreciated..

1. Select cell A1. Then press (Ctrl+A) to select all cells
2. From menu Format>Conditional Formatting>
3. For Condition1>Select 'Formula Is' and enter the below formula
=COUNTIF(1:1,"*TOTAL*")
4. Click Format Button>Pattern and select your color (say Red)
5. Hit OK
You can remove the * from the formula if you are looking for a whole cell
match.
 
J

Joel

I don't think you want to put conditional formating in every cell in the
worksheet because it will use up a lot of memory and slow down the workbook.
I put the formating only in the area where data is located.

Set LastCell = Cells.SpecialCells(xlCellTypeLastCell)
Set UsedArea = Range(Range("A1"), LastCell)
With Range("A1")
.FormatConditions.Delete
.FormatConditions.Add _
Type:=xlExpression, _
Formula1:="=COUNTIF(1:1,""*TOTAL*"")"
.FormatConditions(1).Interior.ColorIndex = 3
.Copy
UsedArea.PasteSpecial _
Paste:=xlPasteFormats
End With
End Sub
 
T

Tree

Joel - thank you, but this did not work quite the way expected.. it did apply
formatting but not to all total rows.. I'm not sure how it was discerning
which row to apply the formatting to? It didn't seem to have any kind of
discipline.. and it was not the formatting I wanted.. it put bold thick lines
on every row and changed the date column to numbers and not dates and it did
not apply the coloring to the rows with the word TOTAL in them.. and we will
need to "end" the paste command within the macro.. it finds the last cell and
stops, but it is still "active copying" because it has that "Select
Destination and press ENTER or choose Paste" message in the bottom left hand
corner..

I wish there was a way I could "show" you the result but I guess I can only
tell you.. plus, I wanted to know how to get this saved once it's working so
that I can call it up anytime I need it.. would that be saving it to the
xlstart folder?
Here is exactly what I am using for the macro code:

Sub Formattotals() - NOTE OUTSIDE OF THE MACRO - I had to add this line?
Set LastCell = Cells.SpecialCells(xlCellTypeLastCell)
Set UsedArea = Range(Range("A1"), LastCell)
With Range("A1")
.FormatConditions.Delete
.FormatConditions.Add _
Type:=xlExpression, _
Formula1:="=COUNTIF(1:1,""*TOTAL*"")"
.FormatConditions(1).Interior.ColorIndex = 3
.Copy
UsedArea.PasteSpecial _
Paste:=xlPasteFormats
End With
End Sub

Again, thank you so much for your time and guidance!
 
J

Joel

I don't know why you need conditional formating when you can just highlight
the cell in red. Putting conditional formating in every cell will slow down
the workbook. I think the colorindex red was being over-written by the
pastespecial using format. Anyway I think using the find method maybe
better. See changes below.

Sub Formattotals()

Set c = Cells.Find(what:="TOTAL", _
MatchCase:=False, LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
FirstAddr = c.Address
Do
If Application.Intersect(c, Range("A1")) Then
c.PasteSpecial _
Paste:=xlPasteFormats
c.Interior.ColorIndex = 3
Range("A1").Copy
Set c = Cells.FindNext(after:=c)
End If
Loop While Not c Is Nothing And c.Address <> FirstAddr
End If
End Sub
 
T

Tree

Joel, I so appreciate your assistance on this issue..
I did get an error message when I ran the macro - it said Run Time Error 91
- Obj Var or With Block Var not set.. I tried to figure out what that meant
but it was beyond my current expertise..
Please let me know what I can do to correct the macro..
Thanks again!
 
K

keiji kounoike

Other way. Try this one.

Sub FormatTotaltest()
Dim Tarea As Range

Cells.Interior.ColorIndex = xlNone
Set Tarea = Range("A1").CurrentRegion

For Each rng In Tarea.Rows
If Application.CountIf(rng, "*TOTAL*") > 0 Then
Application.Intersect(rng, Tarea). _
Interior.ColorIndex = 3
End If
Next

End Sub

Keiji
 
T

Tree

Thank you so much Keiji! This worked perfectly! Except when I tried it with a
QB export where I didn't go through the data and get rid of any blank cells..
and that may happen sometimes.. usually I will go through the exported data
and "clean it up" so that I can run the DATA > SUBTOTAL feature in Excel..
When I did that and then run your macro, it worked BEAUTIFULLY! Can you help
with this problem? And also how do I get this macro "saved" so that I can use
it for ANY worksheet without having to copy it from Notepad and Insert as a
Module every time?
Again, thank you so much for your help!!!
 
K

keiji kounoike

I don't know what QB is and can't understand "I didn't go through the
data and get rid of any blank cells". you seemed to be able to clean it
up manually, then you could write a macro with a same procedure. Run
that clean-up macro first, next run your format macro. I don't know how
you clean up your data, so i can't help you with this.

About using this macro from any workbooks, you can use personal.xls or
make Add-in file. How to make these, Look up the URL
http://www.rondebruin.nl/personal.htm in Ron's Excel Tips

Keiji
 
T

Tree

QB stands for Quickbooks.. we export data quite frequently into Excel to
create reports. If I did a cleanup macro - I don't see how that would work as
the rows and columns to cleanup change with each export and circumstance and
I certainly don't know how to account for that?
Could not your macro be adjusted to compensate for any blank rows or
columns? It works if there are no blank rows or columns and we might want to
run it with blank rows or columns.. Basically, I would like the macro to be
available to run WHENEVER subtotals are in the sheet and so therefore if the
word total is in ANY cell regardless of if there are blank rows or columns..
Again, your help is greatly appreciated..
 
K

keiji kounoike

Try this one, though i don't know this is what you want.

Sub FormatTotalRevised()
Dim Tarea As Range
Dim lr As Long, lc As Long

Cells.Interior.ColorIndex = xlNone

lr = Cells.Find("*", , , , xlByRows, xlPrevious).Row
lc = Cells.Find("*", , , , xlByColumns, xlPrevious).Column

Set Tarea = Range(Cells(1, "A"), Cells(lr, lc))

For Each rng In Tarea.Rows
If Application.CountIf(rng, "*TOTAL*") > 0 Then
Range(Cells(rng.Row, "A"), Cells(rng.Row, lc)) _
.Interior.ColorIndex = 3
End If
Next

End Sub

If you don't want to have personal.xls or Add-in, save this macro into
another book, for example, Mymacro.xls. First open this Mymacro.xls,
next open your data file in the same Excel. you could see the name of
the macro above as Mymacro.xls!FormatTotalRevised. select this one and run.

Keiji
 
T

Tree

YOU ARE AMAZING.. PERFECT! I will work on where I put it so I can have access
and if I need more help with that, I know where to come..
THANK YOU!!!!!!!!!!!!!!!!!!!
 
K

keiji kounoike

You're welcome!

Keiji
YOU ARE AMAZING.. PERFECT! I will work on where I put it so I can have access
and if I need more help with that, I know where to come..
THANK YOU!!!!!!!!!!!!!!!!!!!
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top