VBA Count cells in column containing specified value - vba

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))}

Related

IF() Multiple Cells are equal then "TRUE" with only taking number values in a range

I am trying to write a formula to take only number formats from a row to in order to use an IF formula that illicit the value of "No" if all cells are equal to each other.
See a snippet of my file here:
The problem I am having is that the formula is taking the blank cells (no formats) and counting them in the equation still, so all of my values are "Yes". How do I let my formula only calculate from cells that have numbers in them for each row? I have tried the IFNUMBER(), IFEMPTY() etc... but I am not sure I am employing these correctly e.g. nesting into my formula. I need to ignore the blanks in each row.
Note: I need to only take the cells with number values. I have cleared the contents of values of the rows that do not have number values.
Here is the equation that I currently have:
=IFERROR(IF(AND(ROUND($E2,3)=ROUND($F2,3),ROUND($F2,3)=ROUND($G2,3),ROUND($G2,3)=ROUND($H2,3),ROUND($H2,3)=ROUND($I2,3),ROUND($I2,3)=ROUND($J2,3),ROUND($J2,3)=ROUND($K2,3),ROUND($K2,3)=ROUND($L2,3),ROUND($L2,3)=ROUND($M2,3),ROUND($M2,3)=ROUND($N2,3)),"No","Yes"),"")
Note: this is taking blanks and counting them (as stated from above). It should produce a "Yes" if there are numbers different in the column and a "No" if there are no numbers differences. Currently, it is always producing a "Yes" because it is counting the blanks in the columns.
I am open to a vba solution as well, I have the following from code, but I do not know how to set the range for each row to only look for number formats:
Here is my vba code:
Dim arng As Range
Dim aworkrng As Range
Dim brng As Range
Dim bworkrng As Range
On Error Resume Next
Set aworkrng = Range("O2:O1550")
Set bworkrng = Range("E2:N1550")
Set brng = Range("E2:N2")
On Error Resume Next
For Each arng In aworkrng
If Not IsEmpty(brng.Value) Then
arng.Formula = _
"=IFERROR(IF(AND(ROUND(RC5,3)=ROUND(RC6,3),ROUND(RC6,3)=ROUND(RC7,3),ROUND(RC7,3)=ROUND(RC8,3),ROUND(RC8,3)=ROUND(RC9,3),ROUND(RC9,3)=ROUND(RC10,3),ROUND(RC10,3)=ROUND(RC11,3),ROUND(RC11,3)=ROUND(RC12,3),ROUND(RC12,3)=ROUND(RC13,3),ROUND(RC13,3)=ROUND(RC14,3)),""No"",""Yes""),"""")"
Range("O3").Select
End If
Next
If anyone can help me on this, I would great appreciate it!
Try:
=IF(MIN(E2:N2)=MAX(E2:N2),"No","Yes")

Best way to return data from multiple columns into one row?

I have a sheet with just order numbers and another with order numbers and all of the data associated with those order numbers. I want to match the order numbers and transfer all of the available data into the other sheet. I've been trying to use loops and VLOOKUP but I'm having problems (plus I have 116 columns I want to transfer data from so my vlookup expression doesn't look very nice). Any advice would be appreciated!
this is what I have so far and I'm getting an object error.
I don't think it's the right way to go about it in general though.
Dim LookUpRange As Range
Dim row As Range
Set LookUpRange = Worksheets("batches").Range("B4:B1384")
Set row = Worksheets("batches").Range("C:DL")
For Each row In LookUpRange
row.Select
Selection.FormulaArray ="=VLOOKUP(RC[-1],OrderLvl!RC[-1]:R[1380]C[113],{2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,207,108,109,110,111,112,113,114,115},FALSE)"
Next row
End Sub
Please consider this VBA script to resolve your inquiry:
Sub LookupOuput()
Dim OrderNumberColumn As Range
Set OrderNumberColumn = Worksheets("batches").Range("B2:B1384")
Dim LookUpRange As Range
Set LookUpRange = Worksheets("OrderLvl").Range("C:DL")
Dim cell As Range
Dim FindResult As Range
For Each cell In OrderNumberColumn
If Not cell.Value2 = Empty Then
Set FindResult = LookUpRange.Find(what:=cell.Value2)
If Not FindResult Is Nothing Then
cell.Range("A1:DJ1").Value2 = LookUpRange.Rows(FindResult.row).Value2
End If
End If
Next cell
End Sub
Basically searches for each Order Number in the first sheet on the second sheet. This outputs (if search term exists) the cell that that string is found which we later refer to its row number to output the whole row to the first sheet. Cheers,
A regular VLOOKUP may be able to give you what you need, if you use a small trick...
Insert a row above the data table, and put sequential numbers in
each cell of that row. (ie, A1 = 1, B1 = 2, C1 = 3, etc...)
Do the same thing on your blank table.
Assuming that your first order number is in cell A2, put the following formula into B2: =VLOOKUP($A2,[other sheet name]!$A$1:$DZ$5000,B$1,0)
Drag this formula across all 116 columns, then down all however many rows you've got.
You'll need to adjust the ranges, obviously, but make sure that your lookup array starts in column A. (or alternatively, that your numbers start in the same column as the first column in your array.) Adding the numbers along the top allows you to change what column of the array you're referencing, just by dragging the cell formula.

VBA applying function to each cell in range

I need to write macro or function or whatever in VBA, what will apply a function with arguments (e.g. vlookup) on a rangeof cells. I thought it can be done by macro, but there I could not use arguments for vlookup, so I dont know any way how to do it. Is it possible?
For example:
I want to have this:
vlookup(A1;G1:H50;2;0) in cell B1 and
vlookup(A2;G1:H50;2;0) in cell B2 and so on, to e.g. B10
but I want to write formula only once and let other cells to be filled automaticaly.
Thanks a lot.
If I understand you correctly, here is one way (you'll have to change the delimiter to match your country settings, and adjust where you want the formula to go, I just put in B1:B10 as an example):
Sheet1.Range("B1:B10").Formula = "=vlookup(A1,$G$1:$H$50,2,0)"
This bit of code will write the formula to the range B1:B10 on sheet1, which has the same effect of putting the formula in the B1 and then "dragging" it down to B10. What makes this work is that Excel has the built in functionality of auto-incrementing a formula references based on whether or not the range is preceded by a $ symbol.
If a column reference has a $ in front, it will not increment as the formula is dragged across columns. If the $ is in front of the row reference, it will not increment as the formula is dragged down.
So looking back at my proposed formula, you can see that the A1 will increment as the formula is dragged to B2, B3, B4, etc...auto-incrementing the look up value to be cell A2, A3, A4, respectively. The look up range does not change at all because both the column and the row references are preceded by a $.
If you run the code I gave you, you'll see that you should have the expected results of only writing one formula, but changing the look up range through the built in auto incrementing functionality.
--------------------More edits based on comments--------------------
To do what you want, you don't need VBA at all (even though you initially requested a VBA / macro solution). You can put the formula in a cell and drag it down to how ever far down you want it to go. Please take a look at this link to see if it helps answer your questions:
How to fill data automatically in Excel
You could use Application.VLookup just like this following this example http://www.exceltrick.com/formulas_macros/vlookup-in-vba/:
Sub SetValues(columnToChange As String, columnToLookup As String, range As String, startColumn As Integer, endColumn As Integer)
For number = startColumn To endColumn Step 1
valueLookup = columnToLookup + CStr(number)
valueToChange = columnToChange + CStr(number)
Sheets("yourSheetName").Range(valueToChange).value = Application.VLookup(valueLookup, range, 2, 0)
Next number
End Sub
If you want to call them, create another subroutine without parameters that you can call from a button click for instance.
Sub DoStuff()
On Error GoTo ErrorHandler
Dim valueLookup as String
Dim valueToChange as String
Dim range as String
Dim firstColumn as Integer
Dim lastColumn as Integer
Label1:
valueLookup = InputBox("Enter the column to lookup")
valueToChange = InputBox("Enter the column to change")
range = InputBox("Enter the range of the lookup")
firstColumn = CInt(InputBox("Enter the first column number to lookup"))
lastColumn = CInt(InputBox("Enter the last column number to lookup"))
Call SetValues(valueToChange, valueLookup, range, firstColumn, lastColumn)
Exit Sub
ErrorHandler:
MsgBox("One value has an error in it.")
Resume Label1:
End Sub

Is there way to find duplicate words?

I'm trying to find/make a program that will find all my duplicate words in Excel. For example in A1 "someone" in A2 ""person" and etc but I'll have "someone" multiples times or another word and I need to condense that information together. But I need to do it in a way where I don't search manually to concatenate duplicates. So is there a way to find the duplicate words and concatenate them?
I have also been looking into doing it using "FIND" to look for them but it has yielded no luck yet. I also have been using the "FILTER" but I don't know a way to condense the duplicates without doing it manually. I also been wondering where you can find the code for functions like "FIND, REPLACE and ect."? If I could find that I could change the coding for "REMOVE DUPLICATES" to change it for words. But hey I don't really know if that really would work or not. Anything would help.
For example:
column1 column2 column3
-----------------------------
y A (nothing)
z B (nothing)
z (nothing) I
x (nothing) k
y (nothing) j
x C (nothing)
to this
column1 column2 column3
-----------------------------
y A j
z B I
x C k
except the letters are words.
I don't know if you could do this with formulas in Excel unless you know what word you are looking for within the cell. You could try either a UDF, or a Regular Expression.
my question and answer with links might get you started:
StackOverflow: formula to see if a surname is repeated within a cell
and maybe:
VBA Express
Once you've posted your Excel worksheet with data we see if I've got it wrong!
You could use advanced filter to copy unique values from column 1 to a new column. Then you would use a vlookup formula to get the rest.
Assumptions:
Row 1 is a header row so actual data starts in row 2
Column1 is column "A"
Column2 is column "B"
Column3 is column "C"
The new column with the unique values is column "E".
In cell F2 and copied over to G2 and then down as needed:
=INDEX(INDEX($B$2:$C$7,0,COLUMNS($E2:E2)),MATCH(1,INDEX(($A$2:$A$7=$E2)*(INDEX($B$2:$C$7,0,COLUMNS($E2:E2))<>""),),0))
Sheet1 Before:
Code:
Sub Macro1()
With Sheet1
.Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("F1:F2"), CopyToRange:=.Range("K1"), Unique:=True
.Columns("B:B").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("G1:G2"), CopyToRange:=.Range("L1"), Unique:=True
.Columns("C:C").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("H1:H2"), CopyToRange:=.Range("M1"), Unique:=True
End With
End Sub
Sheet1 After:
make sure field names are used.
This will give you a function that will find the first non-blank cell against a specific string
Option Explicit
Function NonBlankLookup(SearchTxt As String, LookIn As Range, OffSetRows As Long) As Variant
Dim loc As Range
Dim FirstFound As Range
Set loc = LookIn.Find(what:=SearchTxt)
While Not (loc Is Nothing)
If Not IsEmpty(loc.Offset(0, OffSetRows)) Then
NonBlankLookup = loc.Offset(0, OffSetRows).Value
Exit Function
End If
If FirstFound Is Nothing Then
Set FirstFound = loc
ElseIf loc = FirstFound Then
NonBlankLookup = CVErr(2000)
Exit Function
End If
Set loc = LookIn.Find(what:=SearchTxt, after:=loc)
Wend
NonBlankLookup = CVErr(2000)
End Function
to use, insert this code into a module, then in your excel spreadsheet, you can use a formula like =NonBlankLookup(E1,$A$1:$A$6,1) which will search for your text in A1:A6, and check 1 column to the right. If no text is found that matches the search string, or if the text is found but no data exists in the specified column, #NULL! is returned.
This also has a slight advantage to vlookup, as it will allow negative offset, so you could have the search text in column 2, and by using -1 for the offset, you could return data from column 1
Just so you are aware, because of the way that .find works, when you specify a range, it will start at the 2nd cell, and go down, and search the first cell you give it last.
e.g. with my example of A1:A6, it will search A2,A3,A4,A5,A6 and finally A1

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

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