Solved

Conditionally apply a cell fill

Posted on 2011-09-04
6
280 Views
Last Modified: 2012-05-12
Dear Experts:
   below macro code ...
... searches for cells with text entries in column B.
... if found these cells are filled with a cell fill of RGB (222, 222, 222).

This code was furnished courtesy of 'nutsch'. It works very well!

In the meantime new requirements surfaced.

I would like to get this macro tweaked / re-written so that the conditions for the cell fill are as follows:

1) the cell has to have a text entry (ie. not numeric) and
2) one character in these cells has to be a ? (Question mark) and
3) the string must start with a uppercase letter.

I have attached a sample file for your convenience.

Help is much appreciated.  Thank you very much in advance.

Regards, Andreas

 Conditional-Cell-Fill.xlsx
Sub FillCellsOnCondition()

Dim lLastRow As Long, lLoop As Long

lLastRow = Cells(Rows.Count, "B").End(xlUp).Row


For lLoop = 1 To lLastRow
   If Not (IsNumeric(Cells(lLoop, 2))) Then Cells(lLoop, 2).Interior.Color = RGB(222, 222, 222)
Next

End Sub

Open in new window

0
Comment
Question by:AndreasHermle
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
6 Comments
 
LVL 24

Assisted Solution

by:StephenJR
StephenJR earned 150 total points
ID: 36482623
A marginally different approach:
Sub FillCellsOnCondition()

Dim r As Range

For Each r In Columns(2).SpecialCells(xlCellTypeConstants, xlTextValues)
    If InStr(r, "?") > 0 And Left(r, 1) = UCase(Left(r, 1)) Then
        r.Interior.Color = RGB(222, 222, 222)
    End If
Next r

End Sub

Open in new window

0
 
LVL 7

Accepted Solution

by:
kemi67 earned 200 total points
ID: 36482629
try this
 
Sub FillCellsOnCondition()

Dim lLastRow As Long, lLoop As Long

lLastRow = Cells(Rows.Count, "B").End(xlUp).Row


For lLoop = 1 To lLastRow

   If Not (IsNumeric(Cells(lLoop, 2))) And InStr(Cells(lLoop, 2), "?") > 0 And UCase(Left(Cells(lLoop, 2), 1)) = Left(Cells(lLoop, 2), 1) Then
       Cells(lLoop, 2).Interior.Color = RGB(222, 222, 222)
   End If
Next

End Sub

Open in new window

0
 
LVL 33

Expert Comment

by:Rob Henson
ID: 36483257
If either of options 2 or 3 are True then option 1 will automatically be true so can be ignored because both 2 & 3 will be checking for text entry.

Thanks
Rob H
0
MS Dynamics Made Instantly Simpler

Make Your Microsoft Dynamics Investment Count  & Drastically Decrease Training Time by Providing Intuitive Step-By-Step WalkThru Tutorials.

 
LVL 85

Assisted Solution

by:Rory Archibald
Rory Archibald earned 150 total points
ID: 36484012
NFP

You could also use Like:
Sub ColourCells()
    Dim rngCell As Range
    For Each rngCell In Range("B:B").SpecialCells(xlCellTypeConstants, 2)
        If rngCell.Text Like "[A-Z]*[?]" Then
            rngCell.Interior.Color = RGB(222, 222, 222)
        End If
    Next rngCell
End Sub

Open in new window

0
 

Author Comment

by:AndreasHermle
ID: 36484819
Hi everyone:

thank you very much  for your overwhelming support. All of the codes are working although I had to substitute (xlCellTypeFormulas) for (xlCellTypeConstants) on rorya's and Stephen's code.
I did not mention this in my post that the values are linked to some other sheet.

I suggest splitting the points with Kemi getting awarded a little bit more. His code works without any tweaking. Anyhow I would like to split the points since all the different approaches are of great value to me.

Again, thank you very much for your great/professional support.

Regards, Andreas
0
 

Author Closing Comment

by:AndreasHermle
ID: 36484843
Great support from everybody. Really superb forum!
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
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…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.

733 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