CountIf and SumProduct in Excel VBA - excel

I am trying to count the number of unique values in a table column. I have set the range as the relevant column in the table. In defining the number of unique values to count I am getting the following error:
Required_Rows = WorksheetFunction.SumProduct(1 / WorksheetFunction.CountIf(Range(Rng), Range(Rng)))

You won't be able to use Sumproduct and SumIf in that manner. Try using the Evaluate method instead...
Dim Required_Rows As Variant 'declared as Variant in case Evaluate returns error
Required_Rows = Evaluate("SUMPRODUCT(1/COUNTIF(A1:A10,A1:A10))")
If Not IsError(Required_Rows) Then
'do something
Else
'do something else
End If
Note that Evaluate has a 255 character limit.
EDIT
With the Range object you've defined (ie. Rng), try...
Required_Rows = Evaluate("SUMPRODUCT(1/COUNTIF(" & Rng.Address(external:=True) & "," & Rng.Address(external:=True) & "))")
Hope this helps!

Related

Concatenate values of more cells in a single variable in vba

I have an excel file with four columns: name, surname, address, area.
There are a lot of rows.
Is there a way to concatenate all the values of every single row in a variable, using vba?
I need a variable that should contain something like this:
(name1, surname1, address1, area1); (name2, surname2, address2, area2); (name3, surname3, address3, area3)...
If you have the following data in your worksheet
Then the following code will read the data into an array …
Option Explicit
Public Sub Example()
Dim RangeData() As Variant ' declare an array
RangeData = Range("A1:D5").Value2 ' read data into array
End Sub
… with the following structure:
Alternatively you can do something like
Public Sub Example()
Dim DataRange As Range
Set DataRange = Range("A2:D5")
Dim RetVal As String
Dim Row As Range
For Each Row In DataRange.Rows
RetVal = RetVal & "(" & Join(Application.Transpose(Application.Transpose(Row.Value2)), ",") & "); "
Next Row
Debug.Print RetVal
End Sub
To get this output:
(name1, surname1, address1, area1); (name2, surname2, address2, area2); (name3, surname3, address3, area3); (name4, surname4, address4, area4);
.. is there a way to write the result like a sort of list that shows all the values of the cells of the range?
Yes, there is. In addition to PEH's valid answers and disposing of Excel version MS365 you might also use
Dim s as String
s = Evaluate("ArrayToText(A2:D5, 1)") ' arg. value 1 representing strict format
resulting in the following output string:
{"name1","surname1","address1","area1";"name2","surname2","address2","area2";"name3","surname3","address3","area3";"name4","surname4","address4","area4"}
Syntax
ARRAYTOTEXT(array, [format])
The ARRAYTOTEXT function returns an array of text values from any specified range. It passes text values unchanged, and converts non-text values to text.
The format argument has two values, 0 (concise default format) and 1 (strict format to be used here to distinguish different rows, too):
Strict format, i.e. value 1 includes escape characters and row delimiters. Generates a string that can be parsed when entered into the formula bar. Encapsulates returned strings in quotes except for Booleans, Numbers and Errors.
Thank you for your answers, suggestions, ideas and hints. I am sorry if my question was not so clear, all the solutions you added were perfect and extremely elegant.
In the end I found a way - a dumber way in comparison to all the things you wrote - and I solved with a for statement.
I did like this:
totRow = ActiveSheet.UsedRange.Rows.Count
For i = 1 To totRow
name = Cells(i, 1)
surname = Cells(i, 2)
address = Cells(i, 3)
area = Cells(i, 4)
Example = Example & "(" & name & ", " & surname & ", " & address & ", " & area & "); "
Next i
Range("E1").Value = Example
It works (it does what I wanted to do), but I noticed a little limit: if the rows are a lot I can't keep the whole text in the variable.

Transpose a split range into a variant array

Morning all, I just tried something and it didn't work.
If I use this function:
Public Function GetPeople()
GetPeople = Application.WorksheetFunction.Transpose(wsPeople.Range("A2:A10").Value2)
End Function
I get a 1D variant / array of 9 strings with the values in cells from A2:A10
I'm trying to do the same for a split range:
Public Function GetPeople2()
GetPeople2 = Application.WorksheetFunction.Transpose(wsPeople.Range("A2,A5,A10").Value2)
End Function
But it only returns the value from A2 and not all three like I wanted.
In reality this split range is defined by a helper column with an "x" - any rows marked "x" will need to be included in this split range.
What is the simplest way to get the same 1D variant array of strings as a function return, but by using a split range?
It's probably just a classic cycling through rows but wondered if .Transpose could still be used.
Office 365 solution (via contiguous range reference)
In reality this split range is defined by a helper column with an "x" - any rows marked "x" will need to be included in this split range.
This allows to pass the entire (contiguous) data column range as function argument evaluating the condition only "x" using the new worksheet function FILTER() with its dynamic Office 365 possibilities.
This allows to get the wanted data directly instead of going the long way round creating a non contiguous range reference first and you can code a one-liner:
Public Function GetPeopleX(rng As Range, _
Optional ByVal criteria = "x", _
Optional ByVal myOffset As Long = 1)
GetPeopleX = Application.Transpose(Evaluate("=Filter(" & rng.Address & "," & rng.Offset(, myOffset).Address & "=""" & criteria & ""","""")"))
End Function
Example call
Sub ExampleCall()
Debug.Print Join(GetPeopleX(Sheet1.Range("A2:A10")), ", ")
End Sub
Addendum
If it's probable that there isn't at least one row marked by x you could add the following error handling to the function GetPeopleX():
On Error Resume Next
Debug.Print UBound(GetPeopleX) ' << force possible error if nothing found
If Err.Number <> 0 Then GetPeopleX = Array(): Err.Clear
As the error handling returns only a declared array without entries (LBound: 0, Ubound: -1), this allows to use Join() for any result, but to check for positive array results in the calling routine via boundaries. So an items count could be done via LBound().
Filter() function
The WorksheetFunction itself building the basis of GetPeopleX() in a simplified form could be
=FILTER(A2:A10,B2:B10="x","")
Syntax: =FILTER(array,include,[if_empty])
c.f. Help Reference Filter function

How to reference a collection in a formula

All I want to do is reference a collection in a formula. Like
Assume I already know how to make collections and arrays and have done so in my macro, Collection is literally a collection with only 1 column, and Textstring is an array vector.
'For every value of i in Textstring, I want to count the occurrence of that value in all the values of 'Collection'
For i = 1 to Whatever
=COUNTIF(Collection, """ & TextString(i) & """)
Next i
What I want to know is how to make aforementioned code work.
It should work like a normal countif:
'ie: "=COUNTIF('Sheet1'!A1:A10, ""blah"")"
You can't with COUNTIF, if you have a look at the arguments to the function, it expects a Range object.
The only suggestion I have is to do something like the below, i.e. write it out to a worksheet and then use that range as a parameter to your function ...
Public Sub CollectionToRange()
Dim objCollection As New Collection, i As Long
For i = 1 To 10
objCollection.Add i
Next
' Convert the collection to a range.
For i = 1 To objCollection.Count
Sheet1.Cells(i, 1) = objCollection.Item(i)
Next
' Pass the range into the worksheet function.
Debug.Print "CountIf Result = " & WorksheetFunction.CountIf(Sheet1.Range("A1:A" & objCollection.Count), ">3")
' Perform a clean up if required.
End Sub
Not sure if that helps or not.

Find how many words from cell are found in an array

I have two columns with data. The first one has some terms and the other one contains single words.
what I have
I'm looking for a way to identify which words from each cell from the first column appear in the second, so the result should look something like this (I don't need the commas):
what I need
My question is somehow similar to Excel find cells from range where search value is within the cell but not exactly, because I need to identify which words are appearing in the second column and there can be more than one word.
I also tried =INDEX($D$2:$D$7;MATCH(1=1;INDEX(ISNUMBER(SEARCH($D$2:$D$7;A2));0);))
but it also returns only one word.
If you are willing to use VBA, then you can define a user defined function:
Public Function SearchForWords(strTerm As String, rngWords As Range) As String
Dim cstrDelimiter As String: cstrDelimiter = Chr(1) ' A rarely used character
strTerm = cstrDelimiter & Replace(strTerm, " ", cstrDelimiter) & cstrDelimiter ' replace any other possible delimiter here
SearchForWords = vbNullString
Dim varWords As Variant: varWords = rngWords.Value
Dim i As Long: For i = LBound(varWords, 1) To UBound(varWords, 1)
Dim j As Long: For j = LBound(varWords, 2) To UBound(varWords, 2)
If InStr(1, strTerm, cstrDelimiter & varWords(i, j) & cstrDelimiter) <> 0 Then
SearchForWords = SearchForWords & varWords(i, j) & ", "
End If
Next j
Next i
Dim iLeft As Long: iLeft = Len(SearchForWords) - 2
If 0 < iLeft Then
SearchForWords = Left(SearchForWords, Len(SearchForWords) - 2)
End If
End Function
And you can use it from the Excel table like this:
=SearchForWords(A2;$D$2:$D$7)
I have a partial solution:
=IF(1-ISERROR(SEARCH(" "&D2:D7&" "," "&A2&" ")),D2:D7&", ","")
This formula returns an array of the words contained in the cell (ranges are according to your picture). This array is sparse: it contains empty strings for each missing word. And it assumes that words are always separated by one space (this may be improved if necessary).
However, native Excel functions are not capable of concatenating an array, so I think the rest is not possible with native formulas only.
You would need VBA but if you use VBA you should not bother with the first part at all, since you can do anything.
You can create a table with the words you want to find across the top and use a formula populate the cells below each word if it's found. See screenshot.
[edit] I've noticed that it's incorrectly picking up "board" in "blackboard" but that should be easily fixed.
=IFERROR(IF(FIND(C$1,$A2,1)>0,C$1 & ", "),"")
Simply concatinate the results
=CONCATENATE(C2,D2,E2,F2,G2,H2)
or
=LEFT(CONCATENATE(C2,D2,E2,F2,G2,H2),LEN(CONCATENATE(C2,D2,E2,F2,G2,H2))-2)
to take off the last comma and space
I've edited this to fix the problem with "blackboard"
new formula for C2
=IF(OR(C$1=$A2,ISNUMBER(SEARCH(" "&C$1&" ",$A2,1)),C$1 & " "=LEFT($A2,LEN(C$1)+1)," " & C$1=RIGHT($A2,LEN(C$1)+1)),C$1 & ", ","")
New formula for B2 to catch the error if there are no words
=IFERROR(LEFT(CONCATENATE(C2,D2,E2,F2,G2,H2,I2),LEN(CONCATENATE(C2,D2,E2,F2,G2,H2,I2))-2),"")

Manipulating Ranges in Excel - Returning a Value (Error 2029)

I am a quite new to Excel VBA, and I come from a more... traditional programming background (Java, C). I am having issues with passing a Range Object as a parameter in my User-defined function (see below). The idea of my function is to take several parameters to complete a VLOOKUP of a filtered range.
I may have several syntax issues (I am unsure of my return type and my usage of VLOOKUP), and I would appreciate some guidance on this. See results, more information in my code:
Public Function GETVALUE(screen As String, strEvent As String, dataRange As Range, strDate As String) As String
'ASSUMPTION: dataRange has three columns; first column contains lookup values; Second
' column contains dates for filtering; Third column contains return values
Dim result As String
'remove irrelevant dates in dataRange; apply filter
'ASSUMPTION: This process should return a Range that is removes all Rows that does
'not have strDate in the second column
Dim newRange As Range
'RESULT: Returns #VALUE!. I know this is not the typical := syntax I see in many
'examples but this one apparently compiles, so I use it. I comment this line out
'and try to make the other lines below work with dummy parameters or fixed ranges
newRange = dataRange.AutoFilter(2, strDate)
'Now I try to use the newly filtered, "newRange" and use that in my VLOOKUP
'and return it.
result = [VLOOKUP("*" & screen & "/" & strEvent & "*", newRange, 3, False)]
'I can see an Error 2029 here on Result
GETVALUE = result
'RESULT: Returns #VALUE!
End Function
VLOOKUP ignores any filtering of your data. In other words VLOOKUP will also look in the hidden rows.
I would suggest two alternative approaches:
Copy the visible cells of the filtered range to a new sheet and perform the lookup there:
Set newRange = dataRange.AutoFilter(2, strDate).SpecialCells(xlCellTypeVisible)
set ws = worksheets.Add
ws.Range("A1").Resize(newRange.Rows.Count,newRange.Columns.Count).Value = newRange.Value
etc.
Note that this can not be done in a UDF, you would have to do it in a a Sub.
Store the values in dataRange in a variant array and loop to search for the required value:
Dim arr() as Variant
arr = dataRange.Value
For i = LBound(arr,1) to UBound(arr,1)
If (arr(i,2) = strDate) And (arr(i,1) LIKE "*" & screen & "/" & strEvent & "*"( Then
GETVALUE = arr(i,3)
Exit Function
End If
Next
This I think causes your problem:
result = [VLOOKUP("*" & screen & "/" & strEvent & "*", newRange, 3, False)]
Replace it with this instead:
result = Evaluate("VLOOKUP(*" & screen & "/" & strEvent _
& "*, " & newRange.Address & ", 3, False)")
[] which is shortcut for Evaluate doesn't work on variables.
If it is a direct VLOOKUP like below:
result = [VLOOKUP(D1,Sheet1!$A:$C,3,FALSE)]
it will work. But if you are working with variables as in your example, you have to explicitly state it.
And take note that Evaluate accepts Name argument in a form of string.
So you simply have to concatenate all your strings and then explicitly use Evaluate.
Edit1: Additional Inputs
This will not work as well: newRange = dataRange.AutoFilter(2, strDate).
To pass Objects to a Variable you need to use Set like this.
Set newrange = dataRange.AutoFilter(2, strDate)
On the other hand, AutoFilter method although returning a Range Object fails.
I'm not entirely sure if this can't really be done.
Moving forward, to make your code work, I guess you have to write it this way:
Edit2: Function procedures only returns values, not execute methods
Public Function GETVALUE(screen As String, strEvent As String, rng As Range)
GETVALUE = Evaluate("VLOOKUP(*" & screen & "/" & strEvent & "*, " _
& rng.Address & ", 3, False)")
End Function
To get what you want, use above function in a Sub Procedure.
Sub Test()
Dim dataRange As Range, strDate As String, myresult As String
Set dataRange = Sheet2.Range("A2:E65") 'Assuming Sheet2 as property name.
strDate = "WhateverDateString"
dataRange.AutoFilter 2, strDate
myresult = GETVALUE("String1", "String2", dataRange)
End Sub
Btw, for a faster and less complex way of doing this, try what Portland posted.
Basically you must write :
Getvalue = Application.VLookup( StringVar, RangeVar, ColumnNumberVar)
Vlookup needs your data to be previously ordered in alphabetical order, or it doesn't work.
Excel Developers's approach is a good one too, using a VBA Array.
I can also point the VBA functions FIND, and MATCH, wich will get you the row of searched data, and then you can pull what you need from the 3rd column of that row.
Wichever is faster depends of the size of your range.

Resources