How to count up text of a different font colour in excel - vba

I have a list of names that has been exported from another database into excel. The names in the list that are of interest are highlighted in red font. I would like a way to count it, i.e. John Smith appears 5 times in total in a column but 3 of the 5 times, his name comes up highlighted in red font. So I would like to see how many instances of his name comes up red.
I know How to search all instances of his name e.g. =COUNTIF(A1:A100,"John Smith ")
I've also had help in creating a VB function which counts all values that are red (=SumRed) (once the colour index is specified) in a worksheet by using this:
Function SumRed(MyRange As Range)
SumRed = 0
For Each cell In MyRange
If cell.Font.Color = 255 Then
SumRed = SumRed + cell.Value
End If
Next cell
End Function
I just can't find a way to combine the two counting conditions. Any help would be much appreciated!

You don't need VBA for this but still if you want VBA Solution then you can go with any of the other two answers. :)
We can use Excel formula to find the Font Color of a cell. See this example.
We will be using XL4 macros.
Open the Name Manager
Give a name. Say FontColor
Type this formula in Refers To =GET.CELL(24,OFFSET(INDIRECT("RC",FALSE),0,-1)) and click OK
Explanation of the formula
The Syntax is
GET.CELL(type_num, reference)
Type_num is a number that specifies what type of cell information you want.
reference is the cell reference
In the above formula the number 24 gives you the font color of the first character in the cell, as a number in the range 1 to 56. If font color is automatic, returns 0. And Hence the drawback. Ensure that the entire font color is red. We could have used 64 but that is not working properly.
OFFSET(INDIRECT("RC",FALSE),0,-1) refers to the immediate cell on the left.
Now enter this formula in a cell =IF(AND(Fontcolor=3,B1="John Smith"),1,0) and copy it down.
Note: The formula has to be entered on the Right of the cell which contains the Text.
Screentshot
EDIT (10/12/2013)
To count cells with specific backcolor see THIS link

I think you're almost there but this deserves another function #user bet me to the punch line :(
Function CoundRedAndText(MyRange As Range, Mytext as string) as long
CoundRedAndText = 0
For Each cell In MyRange
If cell.Font.Color = 255 and cell.value like MyText Then
CoundRedAndText = CoundRedAndText + 1 'you had cell.value but dont know why?
End If
Next cell
End Function
Usage, =CountRedAndText(A1:A25, "John Smith")

For Each cell In Range("A1:A100")
If cell.Font.Color = 255 And cell.Value = "John Smith" Then
myCount = myCount + 1
End If
Next

Related

Change font in a cell based on a value

I am trying to change the font in a range of cells depending on the value of these cells. So, I'd like to change the font of D1 depending on D1's value, and I'd like to change the font of D2 depending on D2's value, and so on up to D33.
I was able to find results for how to change the font of A CELL depending on the value of another cell here. This VBA code did the job for D1 only. However, it did not work for D2, D3, D4 and so on.
Could someone help me adjust that code to my need?
I apologize if this question is so easy to answer, but I'm not familiar with how VBA coding works.
This code will do what you've described, in this case applying a font to the text in column C based upon the special characters you mention in column D (Notice that I'm using 1 rather than "1", etc...). If Column D doesn't contain any of those characters, it assumes the desired font name is in column D -- I did this just to provide a test of the code. Of course, you'll need to modify the code for your particular situation, but hopefully this gets you started.
Option Explicit
Sub fontChange()
Dim theRange As Range, cell As Range
Set theRange = Range("C1:C16")
For Each cell In theRange
Select Case cell.Offset(0, 1)
Case 0, 1, "(":
cell.Font.Name = "Wingdings 2"
Case "", ":":
cell.Font.Name = "Wingdings"
Case Else:
cell.Font.Name = cell.Offset(0, 1)
End Select
Next
End Sub
In the animated gif I step through the code so you can see it working.

Conditional Formatting or Macro Enabled - Change cell background color based on another cell value

I have a workstation inventory list that has a purchase date in cell "D" in which I have cell "I2" with =TODAY(). Cell "E" has a formula of =ROUND(YEARFRAC(D3,$I$2),0) to get the # of years value in Cell "E".
My question is regarding cell "F" I'd like for the cell to automatically change color based on the numbers of years in cell "E", but I'm struggling to do so. With either conditional formatting or finding a good macro to do so.
I have attached a screenshot to give you folks a better idea. I might've missed a similar thread while doing my research, but if anyone knows where I could look. That's a good answer for me.
You can use the regular conditional formatting:
Select "Use a formula to determine which cells to format" , set the rule like in the screen-shot below (if Years >= 1 and Years <=3).
Apply this formula to your entire range (don't forget to remove the $ sign before the row number so it will change with the rows numbers).
Repeat this step by adding 2 more rules for the other scenarios (same type by using a formula):
(if Years > 3 and Years <=4) then Yellow.
(if Years > 5) then Red. In your post you wrote: (Years > 5) in your legend in the right, but in your requested screen-shot you actually want to display if (Years >= 5) then Red. so you need to decide which one you want.
Select ColumnF and HOME > Styles - Conditional Formatting, New Rule..., Use a formula to determine which cells to format and Format values where this formula is true::
=AND(ROW()>2,E1>4,E1<>"")
Format..., select red Fill, OK, OK.
Then add a new rule of:
=AND(ROW()>2,E1<5,E1<>"")
with yellow fill and finally a third rule (though you could choose to apply a 'standard' fill instead) of:
=AND(ROW()>2,E1<4,E1<>"")
with the rather strange colour fill.
[1] If not added in the above order they should be rearranged in the Conditional Formatting Rules Manager window with red at the bottom and yellow in the middle.
[2] Check Stop if True for all three rules (or at least the top two).
[3] 0 is covered within the same rule as 1 to 3 years.
[4] To simplify range selection and updating all rules apply to the entire column. This though has complicated avoiding applying the formatting to the first two rows and any that are blank in ColumnE.
Try below conditions, it worked for me. You need to apply three different rules on same range
=$K$5>=5 - Red
=AND($K$5<5,$K$5>3) -Yellow
=AND($K$5>=1,$K$5<=3) - Green
I tend to limit conditional formatting to cases where I use them for a quite small and FIXED (never to be changed/added/deleted/moved) number of cells
Otherwise in the medium/long run it can both result in a worksheet mess (after copying&pasting and/or inserting/deleting cells) and size increase
That's why for the colouring of cells down a list I'd always use a VBA approach, like the following code:
Option Explicit
Public Sub main()
Dim cell As Range
Dim firstColor As Long, secondColor As Long, thirdColor As Long
With Worksheets("Inventory") '<--| change "Inventory" to your actual sheet name
firstColor = .Range("I9").Interior.Color '<--| change "I9" to your actual cell address with "1st color"
secondColor = .Range("I10").Interior.Color '<--| change "I10" to your actual cell address with "2nd color"
thirdColor = .Range("I11").Interior.Color '<--| change "I11" to your actual cell address with "3rd color"
For Each cell In .Range("E3", .Cells(.Rows.Count, "E").End(xlUp)).SpecialCells(XlCellType.xlCellTypeFormulas, xlNumbers) '<--| loop through column "E" from row 3 down to last non empty row cells with numbers deriving from formulas only
cell.Offset(, 1).Interior.Color = Switch(cell.value <= 3, firstColor, cell.value <= 4, secondColor, cell.value > 4, thirdColor) '<--| adjust current cell adjacent one color according to current cell value
Next cell
End With
End Sub
Note: I adjusted Switch() function conditions to match your example column "E" and "F" result, which is slightly different from what would come out of your "NO. Of Years" range legenda. Also, this latter has its first two ranges overlapping each other

Excel If Cell Is Highlighted on VLOOKUP

I have two sheets in excel, one is an order form the other is a production sheet based off the order form.
I am using VLOOKUP to query the order form for the quantity of a given item ordered.
However, sometimes this quantity is highlighted on the order form, indicating that the item in question actually gets produced 2 extra amounts (for free samples).
So for example, in the production form I have:
ITEM|QUANTITY TO PRODUCE
In the order form I have:
ITEM|QUANTITY TO ORDER
I use VLOOKUP to get the match, and this works, but if a cell in QUANTITY TO ORDER is highlighted yellow, then I need the VLOOKUP value to be added by two.
How can I do this? Is there a way to do this automatically, without a macro? My client doesn't want to be manually activating things, they just expect the sheet to work.
Thank you.
VLOOKUP can't do that. What you need to do, is treat a cell's background color as data... and a cell's background color isn't data.
But... this link explains how to do that and what the implications are.
Create a workbook-scoped name (Ctrl+F3) called BackColor referring to =GET.CELL(63,OFFSET(INDIRECT("RC",FALSE),0,-1)), and then add a column immediately to the right of the column where the user highlights cells, and make that column have a formula such as =BackColor<>0 so that it contains TRUE for any highlighted cell in the column immediately to its left.
Hard-coding the extra 2 units into your formula isn't going to be maintenance-friendly, so enter that 2 in a cell somewhere and define a name called ExtraUnits for it.
Then modify your formula to
=[the original VLOOKUP]+IF([lookup the BackColor Boolean], ExtraUnits, 0)
This will add ExtraUnits to the looked up units, for all highlighted cells.
The only drawback is that, as I said above, a cell's background color isn't data as far as Excel is concerned, so your user must trigger a recalculation - just changing cells' background color will not do that, but pressing F9 will.
The below code was found at http://www.mrexcel.com/forum/excel-questions/215415-formula-check-if-cell-highlighted.html
Function CellColorIndex(InRange As Range, Optional _
OfText As Boolean = False) As Integer
'
' This function returns the ColorIndex value of a the Interior
' (background) of a cell, or, if OfText is true, of the Font in the cell.
'
Application.Volatile True
If OfText = True Then
CellColorIndex = InRange(1,1).Font.ColorIndex
Else
CellColorIndex = InRange(1,1).Interior.ColorIndex
End If
End Function
To use the function:
=IF(CELLCORINDEX(A1,FALSE)>0,1,0)
This lets you check the color of the cell , or the text. But you will need to use the Index-match code found here http://www.mrexcel.com/forum/excel-questions/447723-vlookup-returns-cell-address.html in order to match it up.
Also, like the above answer states, highlighting a cell doesn't count as a data change, so even though you can get this info without a macro, if someone updates the cell's highlight status, it will not update the cells using this formula unless automatically.
Sounds like you may need to rethink the Highlighting being the trigger of the +2 samples. I'm with the above answer that recommends adding a column maybe True/False or Yes/No that is checked to see if they get samples.
What I did is this:
I created a user defined function:
Function getRGB3(rcell As Range, Optional opt As Integer) As Long
Dim C As Long
Dim R As Long
Dim G As Long
Dim B As Long
C = rcell.Interior.Color
R = C Mod 256
G = C \ 256 Mod 256
B = C \ 65536 Mod 256
If opt = 1 Then
getRGB3 = R
ElseIf opt = 2 Then
getRGB3 = G
ElseIf opt = 3 Then
If B <> 0 Then
B = -2
End If
getRGB3 = B + 2
Else
getRGB3 = C
End If
End Function
This made it so all the highlighted cells (in yellow) got a value of 2 when referred to, so on the order form it goes like ITEM|QUANTITY TO ORDER|CUSTOM FUNCTION VALUE| and the third column (custom function) is 2 for each corresponding yellow cell next to it, if not, it is just zero.
Then I do a second VLOOKUP to add the CUSTOM FUNCTION VALUE to the original, and then I have added two. :)

Excel: Check if cell string value exists in column, and get all cell references to that string

I suspect this may be a job for VBA, which is beyond my abilities. But here's the scenario:
Column A in Sheet 1 (CAS1) contains x rows of text values
Column A in Sheet 2 (CAS2) contains x rows of text values
Part A - For each row value in CAS1, I need to know if the string is contained in any of the cells in CAS2. Not exact match, the string can be only part of the searched cells.
Part B - I need to know the cell value of each cell in CAS2 that contains the CAS1 value (if they do exist, they can be listed in the cells adjacent to the cell being searched in CAS1).
I've tried the following to attempt Part A, all to no avail:
vlookup(A1,sheet2!A:A,1,false)
NOT(ISNA(MATCH(A1,sheet2!A:A,0)))
ISNUMBER(MATCH(A1,sheet2!A:A,0))
COUNTIF(sheet2!A:A,A1)>0
IF(ISERROR(MATCH(A1,sheet2!A:A, 0)), "No Match", "Match")
I know some of the cell values in CAS2 contain the cell values in CAS1, so I don't know why they return false or No Match. I suspect it may be down to the nature of the text content. So here's some sample data:
CAS1
LQ056
RV007H
RV008
RV009H
TSN304
TSN305
CAS2
RV009-satin-nickel-CO.jpg
STR314.jpg
STR315.jpg
HCY001.jpg
RV008-oval-rad-CO.jpg
HCY001-BRAC006.jpg
Any help would be appreciated.
This problem can be faced through VBA (at least, I imagine the VBA solution much more easily than the possible Excel one). You need a macro that, for each row in CAS1, search the content in each row of CAS2 and returns you the address.
For Each cell In Sheets("CAS1").Range("A1:A" & Sheets("CAS1").Range("A1").End(xlDown).Row) '<-- check each cell of the range A1:A? of sheet CAS1 (adapt "A" and "1" if they're different)
recFound = 0 '<-- count how many findings there are
For Each cell2 In Sheets("CAS2").Range("A1:A" & Sheets("CAS2").Range("A1").End(xlDown).Row) '<-- check in each cell of the range A1:A? of sheet CAS2 (adapt "A" and "1" if they're different)
If InStr(cell2.Value, cell.Value) <> 0 Then '<-- if the value in cell is contained in the value in cell2..
recFound = recFound + 1 '<-- account the new finding
cell.Offset(0, recFound) = Split(cell2.Address, "$")(1) & Split(cell2.Address, "$")(2) '<--write the address on the right of the currently searched cell
End If
Next cell2
Next cell
All the above should be enclosed in a macro, e.g. Sub makeMySearch(), that should be run to get the results. As commented in my code, I'm assuming that data are in A1:A? of both sheets; but they of course might be, for example, in B5:B? of the sheet 1 and in C7:C? of the sheet 2. You need clearly to adapt the code to your current data.
There's no need for VBA. Some simple array-formulas can do the job.
To see if the entry in CAS1 is present in CAS2:
=OR(ISNUMBER(SEARCH(A2,CAS2_)))
will return TRUE or FALSE. BUT this formula has to be entered by holding down CTRL-SHIFT while hitting ENTER If you do this correctly, Excel will place braces {...} around the formula that you can see in the formula bar.
The SEARCH function returns an array of results, which will be either the #VALUE! error, or a number.
In order to return the address, the following array-formula can be entered adjacent to a cell in CAS1:
=IFERROR(ADDRESS(LARGE(ISNUMBER(SEARCH($A2,CAS2_))*ROW(CAS2_),COLUMNS($A:A)),1),"")
Fill right for the maximum number of addresses possible, then select the group and fill down.
In this case, the array being returned is a string of either 0's, or 1 * the row number (i.e. the row number). I assumend the data in CAS2 was in column A, but you can change the column number if needed (or even compute it if necessary, by replacing the 1 in the ADDRESS function with COLUMN(CAS2_))
CAS1_ and CAS2_ are either named ranges, or absolute range references to the two text groups.

VBA Count cells in column containing specified value

I need to write a macro that searches a specified column and counts all the cells that contain a specified string, such as "19/12/11" or "Green" then associate this number with a variable,
Does anyone have any ideas?
Do you mean you want to use a formula in VBA? Something like:
Dim iVal As Integer
iVal = Application.WorksheetFunction.COUNTIF(Range("A1:A10"),"Green")
should work.
This isn't exactly what you are looking for but here is how I've approached this problem in the past;
You can enter a formula like;
=COUNTIF(A1:A10,"Green")
...into a cell. This will count the Number of cells between A1 and A10 that contain the text "Green". You can then select this cell value in a VBA Macro and assign it to a variable as normal.
one way;
var = count("find me", Range("A1:A100"))
function count(find as string, lookin as range) As Long
dim cell As Range
for each cell in lookin
if (cell.Value = find) then count = count + 1 '//case sens
next
end function
If you're looking to match non-blank values or empty cells and having difficulty with wildcard character, I found the solution below from here.
Dim n as Integer
n = Worksheets("Sheet1").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
Not what you asked but may be useful nevertheless.
Of course you can do the same thing with matrix formulas.
Just read the result of the cell that contains:
Cell A1="Text to search"
Cells A2:C20=Range to search for
=COUNT(SEARCH(A1;A2:C20;1))
Remember that entering matrix formulas needs CTRL+SHIFT+ENTER, not just ENTER.
After, it should look like :
{=COUNT(SEARCH(A1;A2:C20;1))}