I am trying to create a custom function to evaluate some data. The data consists of a few samples (in columns) taken from a living organism and the bacteria + their magnitude (in rows). I know which bacteria are unique (only appear in 1 sample) but I want to know how many unique bacteria are in each sample.
To know which bacteria are unique I use =COUNTIF(A:A,">"&0) on each row and if returns a 1 then it is unique.
Ideally I was thinking of something along the lines of:
Function Custom(sampleRange, occurringBacteria) As Integer
Dim bacteriaUniqueToSample as Integer: bacteriaUniqueToSample = 0
For Each sampleRange And occurringBacteria
If sampleRange > 0 And occurringBacteria = 1
Then bacteriaUniqueToSample = bacteriaUniqueToSample + 1
Next
Custom = bacteriaUniqueToSample
End Function
Of course, that is not possible.
Example:
Enter this in cell B7 and copy across till D7
=COUNTIFS(B$2:B$5,">"&0,$E$2:$E$5,"Unique")
A User Defined Function (aka UDF) could be written for this. While your sample layout has a correlation between the cell with the function and the cell holding the Sample1, Sample2, etc labels, to be more universal you will need to provide a wider worksheet relationship.
Function uniq_bacts_by_sampl(rSample As Range, rOccurringBacteria As Range)
Dim cnt As Long, rw As Long, rng As Range
For rw = 1 To rOccurringBacteria.Rows.Count
Set rng = Application.Index(rOccurringBacteria, rw, 0)
If Application.CountIf(rng, ">" & 0) = 1 And _
CBool(Cells(rng.Row, rSample.Column).Value2) Then
cnt = cnt + 1
End If
Set rng = Nothing
Next rw
uniq_bacts_by_sampl = cnt
End Function
The UDF is put to use just as any other native worksheet function.
Syntax: =uniq_bacts_by_sampl(<cell with label criteria>, <data range>)
The formula in the above sample image's B7 is,
=uniq_bacts_by_sampl(B$1, $B2:$D5)
Fill right as necessary.
Related
So I need to count how many ž and č are there in all of these fields.
Example.
http://prntscr.com/jwz1em
I tryed with this code but it gives me 0
Function slova(iVal)
Dim output As Integer
output = Application.WorksheetFunction.CountIf(Range("A2:A11"), "ž")
End Function
I see multiple problems with your code:
There is no assignment of return value to function, in my example slova = charCnt, so it wouldn't return anything besides default 0 no matter what.
It lacks Application.Volatile, so the formula used in Excel cell would require navigating to cell and pressing ENTER to force an update when data in range changes.
Function has an argument iVal which isn't used anywhere.
Application.WorksheetFunction.CountIf returns count of cells, so it is limited to 1 character per cell. On top of it, correctly specified argument would be "*ž*"
Here is my solution to count all occurrences of hardcoded character in hardcoded range (must have exactly 1 column).
Function slova() As Long
Application.Volatile
Dim vData As Variant
Dim rowCounter As Long, charCnt As Long
Const myLetter As String = "ž"
vData = Range("A2:A11")
For rowCounter = LBound(vData) To UBound(vData)
If vData(rowCounter, 1) <> vbNullString Then
charCnt = charCnt + UBound(Split(vData(rowCounter, 1), myLetter))
End If
Next rowCounter
slova = charCnt
End Function
As you use function, you can also take advantage of it and use source range as an argument, the same goes for character.
This code is just to calculate simple moving average. Opened an excel, created dummy array in C row from 1 to 20. I want to create a function for eg: SMA(C7,3) = which should give average of C5:C7.
Coming back to VBA after long time, not able to figure whats the error in the below code.
Function sma1(rng As Range, N As Integer)
Set rng = rng.Resize(-N + 1, 0)
sma1 = Application.WorksheetFunction.average(rng)
End Function
avoid using a cell name as a function
fixed the RESIZE()
used an internal range variable
Function smal(rng As Range, N As Integer) As Variant
Dim rng2 As Range
Set rng2 = rng.Resize(N, 1)
smal = Application.WorksheetFunction.Average(rng2)
End Function
EDIT#1:
Based on Scott's comment:
Function smal(rng As Range, N As Integer) As Variant
Dim rng2 As Range
Set rng2 = rng.Offset(1 - N, 0).Resize(N, 1)
smal = Application.WorksheetFunction.Average(rng2)
End Function
I assume you want the column along side it to give you're SMA (as shown below?):
If so, the below will do it and drag it autocomplete it to the bottom of you column C array:
Sub SMA3()
Range("D7").FormulaR1C1 = "=AVERAGE(R[-2]C[-1]:RC[-1])" 'This is a relative reference (left one cell and up two cells) - This give your three inputs
Range("D7").AutoFill Destination:=Range("D7:D" & Range("C1048576").End(xlUp).Row) 'Autofills the SMA
End Sub
Just an FYI this can be done with existing formula:
=IF(ROW(C1)<$E$1,"",AVERAGE(INDEX(C:C,ROW(C1)-$E$1+1):C1))
E1 contains the number of rows to include.
Another VBA question (I'm on fire lately)
As the title says, I am trying to sum a column that can can be of a variable length and then stick that sum in cell F3, but I am running into a an "application or object defined error.
Here's my code:
Dim last As Range, sum As Variant
ActiveSheet.Range("M8").Select
Set last = Selection.End(xlDown)
With Worksheets("Data")
sum = WorksheetFunction.sum(.Range("M8:M" & last))
End With
Range("F:3") = sum
With Worksheets("Data")
.Range("F3").Value = Application.Sum(.Range(.Range("M8"), .Range("M8").End(xlDown))
End With
Using your method, last needs to be a Long to which you assign the row number.
Dim last As Long
Dim sum As Long
ActiveSheet.Range("M8").Select
last = Selection.End(xlDown).Row
With Worksheets("Data")
sum = WorksheetFunction.sum(.Range("M8:M" & last))
End With
Range("F3") = sum
You could also do it a little more efficiently, by using
last = ActiveSheet.Range("M8").End(xlDown).Row
and not using the Select.
Use this function to robustly count the non-empty cells down from a cell.
' Enumerate non-empty cells down the rows.
Public Function CountRows(ByRef r As Range) As Long
If IsEmpty(r) Then
CountRows = 0
ElseIf IsEmpty(r.Offset(1, 0)) Then
CountRows = 1
Else
CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count
End If
End Function
There is a non VBA way. In cell F3 type the following:
=SUM(OFFSET($M$8,0,0,COUNTA(M:M),1))
NB - this assumes the only content of column M are the numbers you'd like to sum
If I have a loop that commences:
For each c in Range("A1:C8")
Is there a property of the placeholder c (c.count, c.value, c.something,...) that identifies the number of times the loop has iterated thus far? I would rather use something like this than including another variable.
Instead of using a "for each c in range" you can do something like this:
Dim c as Long 'presumably you did this as a Range, just change it to Long.
Dim myRange as Range 'Use a range variable which will be easier to call on later
Set myRange = Range("A1:C8")
For c = 1 to myRange.Cells.Count
'Do something to the cell, identify it as myRange.Cells(c), for example:
myRange.Cells(c).Font.Bold = True '<--- replace with your code that affects the cell
Next
This allows you to do the exact same For/Next loop, without including an unnecessary counter variable. In this case, c is a counter but also serves the purpose of identifying the cell being impacted by the code.
You need to count it yourself like this
Dim i as integer
i = 0
For each c in Range("A1:C8")
i = i + 1
Or
Dim i as integer
Dim c as Range
For i = 0 to Range("A1:C8").Count - 1
Set c = Range("A1:C8").Cells(i)
(Revised)
Using Column or Row properties, as appropriate to the direction you are iterating, you can compute an ordinal number on the fly. Thus
For Each c1 in myRange
myOrdinal = c1.row - myRange.row + 1 ' down contiguous cells in one column
myOrdinal = c1.Column - myRange.Column + 1 ' contiguous columns, L2R
Next
I have a two dimensional table in Excel. eg.
outputproduct blending combination
**5 P1:0.6/P3:0.5**
2 P1:0.3/P2:0.7
4 P5:0.4/P2:0.7
7 P11:0.7/P7:0.4
Suppose the range of the table varies from B2:C6 (it can vary). I have to create a function, whose first job is to read this range( which would be a user defined input) and then stores the data into a 2 dimensional array such that I could use the data(integer) in the first column and the string in the second column, appropriately.
The first column is the resultant product index, while the second column is the blending products in the given ratio, which combine together to give the product in the first column.
Then there is another table:
product index current stock updated stock
**1** **10**
2 20
**3** **50**
4 15
**5** **100**
. .
. .
. .
I have to update the stock amount in this table after the data processing.
For example, on combination of product 1 with product 3 in the ratio of 6:5 (units), 1 unit of product 5 is produced. So, I have to update the amount of stock for each of the products in table 2.
Any suggestions, how to convert the range into a 2 dimensional array?
Public Function Blending_function( R1 as Range, R2 as Range)
' R2 is the range of table 2, where the updating is to be done
' R1 is first stored in to a 2 dimensional array, such that the data in the
' column 1 could be read, and the data in the column 2 could be read (of table 1).
' the integer in the column 1 of table 1 refers to the product index in table 2.
' P(i) stands for the ith product. In first row of table-1, P1 and P3 combine in the
' ratio of 6:5 to give P5. The current stock of each product is provide in table-2,
' whose range is R2(entire table 2).
' R1 is the range of table 1, from where the processing is to be done
End Function
The main hurdle for me is to convert the range R1 (Table-1) into a 2 dimensional array. And then look from that array, the index of the output product, and locate that product in table-2 for updating the stock level.
Here is an example on how to work with 2D array. The function will break up the blending combination and extract the values that you want so that you can use those.
Sub Sample()
Dim Rng1 As Range, Rng2 As Range
On Error Resume Next
Set Rng1 = Application.InputBox("Please select the Table1 Range", Type:=8)
On Error GoTo 0
If Rng1.Columns.Count <> 2 Then
MsgBox "Please select a range which is 2 columns wide"
Exit Sub
End If
On Error Resume Next
Set Rng2 = Application.InputBox("Please select the Table2 Range", Type:=8)
On Error GoTo 0
If Rng2.Columns.Count <> 3 Then
MsgBox "Please select a range which is 3 columns wide"
Exit Sub
End If
Blending_function Rng1, Rng2
End Sub
Public Function Blending_function(R1 As Range, R2 As Range)
Dim MyAr1 As Variant, MyAr2 As Variant
Dim i As Long
Dim blndCom As String, OutputPrd As String
Dim ArP1() As String, ArP2() As String, tmpAr() As String
MyAr1 = R1
For i = 2 To UBound(MyAr1, 1)
OutputPrd = MyAr1(i, 1)
blndCom = MyAr1(i, 2)
tmpAr = Split(blndCom, "/")
ArP1 = Split(tmpAr(0), ":")
ArP2 = Split(tmpAr(1), ":")
Debug.Print OutputPrd
Debug.Print Trim(ArP1(0))
Debug.Print ArP1(1)
Debug.Print ArP2(0)
Debug.Print ArP2(1)
Debug.Print "-------"
Next
End Function
SNAPSHOT
Once you have these values you can use .Find to search for the product index in the range R2 and then use .Offset to enter your formula.
I'm not sure if I understood the entire story, but this is what a function to return
a multidimensional array could look like:
Public Sub Main_Sub()
Dim vArray_R1() As Variant
Dim oRange As Range
Set oRange = ThisWorkbook.Sheets(1).Range("A1:B5")
vArray_R1 = Blending_function(oRange)
'You do the same for The second array.
set oRange = nothing
End Sub
Public Function Blending_function(R1 As Range)
Dim iRange_Cols As Integer
Dim iRange_Rows As Integer
iRange_Cols = R1.Columns.Count
iRange_Rows = R1.Rows.Count
'Set size of the array (an existing array would be cleared)
ReDim vArray(1 To iRange_Rows, 1 To iRange_Cols)
vArray = R1
Blending_function = vArray
End Function
A second option could be to declare the function to return a boolean and since arguments are standard sent byRef; you can declare the ranges and arrays in the main sub only, and convert them both at the same time in the function. I wouldn't choose for this option, because you wouldn't be able to re-use the function afterwards to convert other ranges into arrays.
Supplementary info:
This technique works both ways. You can afterwards define a range and do:
set oRange = vArray
This on the condition that the Range has the same size as the array.
row = 2
column = "B"
Do While Len(Range(column & row).Formula) > 0
' repeat until first empty cell in column 'column'(user input)
' read (column, row) and (column+1, row) value
Cells(row, column).Value
Cells(row, column+1).value
' store in Array
Loop