What is the simplest formula I can use to randomly choose a value in column A that is associated with a given B value. So in the table below, I'm looking to randomly choose an A where B = 3. So I'm randomly choosing between row 1 (5.4) and row 3 (4.2). Note that this table can be arbitrarily large.
A B
1 5.4 3
2 2.3 1
3 4.2 3
4 9.2 2
... ...
Conceptually you could do it a number of ways, but here's one (VBA) where you'd use an array of possible choices then get a random element from that list:
Create a udf that takes a range and the search value
Loop through the row and if it equals your search value, get the value in the cell offset -1 and store it in an array
Once you are done, you'll have an array of all possible answers. Use the randbetween function and give it the lbound and ubound of your array.
Return the i element where i is the random number it picked.
UPDATE:
Here is a code example that loops through the range for the number you specify, and if it find it, it adds the A column value to an array of possible results. Then a random number is generated and used to return a random value from that list.
Function GetRand(ByVal cell_range As Range, ByVal criteria As Double) As Double
Dim cell As Range
Dim rNum As Long
Dim i As Long
Dim possibleChoices() As Double
ReDim possibleChoices(1 To cell_range.Count)
i = 1
For Each cell In cell_range
If cell.Value = criteria Then
possibleChoices(i) = cell.Offset(0, -1).Value
i = i + 1
End If
Next
rNum = Application.WorksheetFunction.RandBetween(1, i - 1)
GetRand = possibleChoices(rNum)
End Function
Optimization:
Here is a more flexible version of the same function. It takes 3 paramteres - the range you want to look in, what you want to find, and the offset value of the cell you want a random result from. It also uses Variants, so you can search for text or numbers. So in your case, you'd write:
=GetRand(B1:B5, 3, -1)
Here is the code:
Function GetRand(ByVal cell_range As Range, _
ByVal criteria As Variant, _
ByVal col_offset As Long) As Variant
Application.ScreenUpdating = False
Dim cell As Range
Dim rNum As Long
Dim i As Long
Dim possibleChoices() As Variant
ReDim possibleChoices(1 To cell_range.Count)
i = 1
For Each cell In cell_range
If cell.Value = criteria Then
possibleChoices(i) = cell.offset(0, col_offset).Value
i = i + 1
End If
Next
rNum = Application.WorksheetFunction.RandBetween(1, i - 1)
GetRand = possibleChoices(rNum)
Application.ScreenUpdating = True
End Function
Old question I know......but if you're still interested here's a formula solution assuming data in A2:B10
=INDEX(A2:A10,SMALL(IF(B2:B10=3,ROW(A2:A10)-ROW(A2)+1),RANDBETWEEN(1,COUNTIF(B2:B10,3))))
returns #NUM! error if there are no 3s in B2:B10.....or enclose in IFERROR to return text of your choosing in that case....
Related
As you can see in the image, there are some 1 and 0s rearranged in 3 rows and one English Alphabet for each column. What I need to do is concatenate the English Alphabets for each row when the respective column value is 0. How can I do it?
Here is a VBA solution that can handle any number of columns (assuming that the letter associated with each column is the standard column label):
Function ZeroColumns(R As Range) As String
Dim n As Long
Dim count As Long
Dim cols As Variant
Dim cell As Range
n = R.Cells.count
ReDim cols(1 To n)
For Each cell In R.Cells
If cell.Value = 0 Then
count = count + 1
cols(count) = Split(cell.Address, "$")(1)
End If
Next cell
ReDim Preserve cols(1 To count)
ZeroColumns = Join(cols, "")
End Function
The code shouldn't be too hard to tweak if the stated assumption doesn't hold.
Conditionally Concatenate Row (UDF)
Arguments
SourceRowRange: The range containing the values that will be
written toCCROW e.g. A, B, C ... Required.
CriteriaRowRange: The range that will be checked for
CriteriaValue. Required.
CriteriaValue: The value that the cells in CriteriaRowRange will
be checked against. Default is 0. Optional.
JoinString: The value that will be put between the values that will
be written to CCROW. Default is "". Optional.
' Copy the following code to a standard module i.e. in VBE go to Insert>Module.
The Code
Function CCROW(ByVal SourceRowRange As Range, ByVal CriteriaRowRange As Range, _
Optional ByVal CriteriaValue As Variant = 0, _
Optional ByVal JoinString As String) As String
Dim vntS As Variant ' Source Array
Dim vntC As Variant ' Criteria Array
Dim NoC As Long ' Number of Columns
Dim j As Long ' Arrays Column Counter
Dim strB As String ' String Builder
Dim strC As String ' Criteria String
' Calculate number of columns of the narrower Range.
NoC = WorksheetFunction.Min(SourceRowRange.Columns.count, _
CriteriaRowRange.Columns.count)
' Copy resized (adjust them to same size) Ranges to Arrays.
vntS = SourceRowRange.Resize(1, NoC)
vntC = CriteriaRowRange.Resize(1, NoC)
' Loop through columns of either Array.
For j = 1 To NoC
' Write current value of Criteria Array to Criteria String.
strC = vntC(1, j)
' Check if Criteria String is NOT empty.
If strC <> "" Then
' Check if Criteria String is equal to Criteria Value.
If strC = CriteriaValue Then
' Check if String Builder is NOT empty.
If strB <> "" Then ' NOT empty.
strB = strB & JoinString & vntS(1, j)
Else ' IS empty (only once).
strB = vntS(1, j)
End If
End If
End If
Next
' Write String Builder to Conditionally Concatenate Row.
CCROW = strB
End Function
Usage in Excel
=CCROW(A$1:I$1,A3:I3) ' Result: ADG
=CCROW(A$1:I$1,A4:I4) ' Result: CFI
=CCROW(A$1:I$1,A5:I5) ' Result: DG
If you add JoinString:
=CCROW(A$1:I$1,A3:I3,,",") ' Result: A,D,G
=CCROW(A$1:I$1,A3:I3,0,",") ' Result: A,D,G
=CCROW(A$1:I$1,A3:I3,0,", ") ' Result: A, D, G
IF you change CriteriaValue:
=CCROW(A$1:I$1,A3:I3,1) ' Result: BCEFHI
=CCROW(A$1:I$1,A4:I4,1) ' Result: ABDEGH
=CCROW(A$1:I$1,A5:I5,1) ' Result: ABCEFHI
Remarks
Lock ($) the row of SourceRowRange to keep it the same when the formula is copied down.
You can do it all in one formula if you like:
=CONCATENATE(IF($A1=0,'A',''),IF($B1=0,'B',''), ...)
Or put the intermediate strings in a separate row and then concatenate them (to save wear and tear on your fingers).
Are you going to this to many more columns, or just the ones you've mentioned? As long as the number of columns is relatively small, as in your picture, you can concatenate IF functions to achieve your result.
Here's what I did:
Using that formula will get you a result like the one you have:
Assuming also that you have the values in a worksheet like mine, just paste the formula =IF(B3=1,"",B$1)&IF(C3=1,"",C$1)&IF(D3=1,"",D$1)&IF(E3=1,"",E$1)&IF(F3=1,"",F$1)&IF(G3=1,"",G$1)&IF(H3=1,"",H$1)&IF(I3=1,"",I$1)&IF(J3=1,"",J$1)
in B7 and then drag to B8 and B9 to get the rest of the results.
Of course, if you are going to do this for many more columns, it's maybe best to use VBA.
Here, add this function to a module.
You can then call it directly via excel. Nice one.
Function conc(ref As Range, Optional Separator As String) As String
Dim Cell As Range
Dim Result As String
For Each Cell In ref
If Cell.Value = 0 Then
Result = Result & chr(64 + Cell.Column) & Separator
End If
Next Cell
If Separator <> "" Then conc = Left(Result, Len(Result) - 1) Else: conc = Result
End Function
The following array formula will do the job (enter it with Ctrl+Shift+Enter):
=CONCAT(IF($A1:$I1=0,UNICHAR(64+COLUMN($A1:$I1)),""))
For older Excel versions, use the legacy functions CONCATENATE() and CHAR() in place of these functions.
I have a process I am trying to code in macros.
For every row in range:
I am trying to select non empty cells in a row.
For those cells, pick a minimum value n_1.
Given a multiplication factor a create an array (same length as the non empty row) of equally spaced numbers starting with the minimum value, i.e. (n_k = (a^k)*n_1).
Something along these lines
Dim a As Range, b As Range, number_of_elements as Integer
Set a = Range()
For Each b In a.Rows
Dim newarray as Variant 'initialize new array
arr = select_non_empty_cells(b) 'select non empty cells
number_of_elements = Ubound(arr) 'get number of elements
ReDim newarray(1 To number_of_elements) As Integer 'set the dimension
min_val = WorksheetFunction.Min(arr.Value) 'pick minimum value
For counter = 1 To number_of_elements 'create new array with equally spaced numbers
newarray(counter) = min_val*1.25^counter 'multiplying factor
Next counter
arr.Value = newarray.Value 'set the non empty range to new values
Next
And below is what my data will look like. So for the first row I would pick 1033.2 (the minimum value) and create new array of the same length of 5 elements evenly spaced. Same for the second row.
Perhaps something like:
Sub Korba()
Dim i As Long, mini As Long
Dim WhichRow As Long
Dim factr As Double
mini = 3
factr = 1.25
WhichRow = 5
For i = 1 To Columns.Count
With Cells(WhichRow, i)
If .Value <> "" Then Exit Sub
.Value = mini * factr ^ i
End With
Next i
End Sub
Input: I have a range in an excel sheet. Let's say B1:F100 = 100X5 matrix on "Sheet 1".
Now I want to count the number of rows that have "Data" in any of the columns B to F (from rows 1 to 100). i.e. I'm looking for a function, let's say, ExistIfRow(B1:F100) that will return a 100X1 array of 0s or 1s. So I can simply do a sum(ExistIfRow(B1:F100)) to get the number of rows.
I would like to be able to select 100 cells and enter this function as an array formula to get that 100X1 result in the sheet.
I hope that makes sense.
In addition, I attempted to create this function but it doesn't show up in my excel sheet when I try to put it in a cell. Can someone please help me see what I am doing wrong?
This function exists under "Modules" in the worksheet.
Function RowWiseOR(Rin As Range, Condition As Variant) As Range
Dim rw As Range
Dim Out As Variant
Dim i As Integer
i = 0
For Each rw In Rin.Rows
If WorksheetFunction.CountIf(rw, Condition) > 0 Then Out(i).Value = 1 Else Out(i).Value = 0
i = i + 1
End
RowWiseOR = Out
End Function
I'm not sure why "it doesn't show up", but there were a few issues with the function itself. Specifically,
The function should return a Variant array, not a Range
The variable Out needed to be initialized as an array to hold the results
Elements of arrays don't have a .Value property. For example, use Out(i) = 1 instead of Out(i).Value = 1
Transpose the array before writing it out to the sheet if you want it to be a column vector.
See below for the revised function:
Function RowWiseOR(Rin As Range, Condition As Variant) As Variant
Dim rw As Range
Dim Out As Variant
Dim i As Integer
i = 0
ReDim Out(Rin.Rows.Count - 1)
For Each rw In Rin.Rows
If WorksheetFunction.CountIf(rw, Condition) > 0 Then Out(i) = 1 Else Out(i) = 0
i = i + 1
Next
RowWiseOR = Application.Transpose(Out)
End Function
Remember to enter it as an array formula. See here for more information.
The reason why Countif is giving an error because countif does not work with array.
Try the same in excel and you will again get an error.
Also i do not understand why you need to create a function to count 0's or 1's. this can be easly achieved by countif formula in excel - COUNTIF(A1:C3,"data")
I have 2 worksheets, Main and Return. I have the values in Main and the results in Return. I am trying to find a particular position in an array containing an index value (the data comes from Main sheet) e.g. 10, 20, 40, 50, 60 etc...then take the 5 values above and 5 values below this index including the index value I am searching for and do an average of it returning the average to a cell on the sheet (to the Return sheet), thus doing an average of 11 values. So far I have managed to store the range in the array using:
Public Sub myArray()
Dim myArr() As Variant
Dim R As Long
Dim C As Long
myArr = Range("C6:D1126")
For R = 1 To UBound(myArr, 1)
For C = 1 To UBound(myArr, 2)
Debug.Print myArr(R, C)
Next C
Next R
End Sub
The search/find of value within the array and averaging has left me scratching my head...
Please help...thank you. Help with the code in the array or manipulating the data from the worksheet itself works fine by me :)
Sample file --> http://www.filedropper.com/indexes
You could use this UDF:
Function avrg(indx, rng As Range)
Dim i, minI As Long, maxI As Long
i = Application.Match(indx, rng.Columns(2), 0)
If IsError(i) Then
avrg = CVErr(xlErrNA)
Exit Function
End If
With WorksheetFunction
minI = .Max(1, i - 5)
maxI = .Min(rng.Rows.Count, i + 5)
avrg = .Average(rng.Cells(1, 1).Offset(minI - 1).Resize(maxI - minI + 1))
End With
End Function
This UDF finds first entry of value (say 10 or 20) in Index column (Main sheet) takes 5 values above and 5 below it and returns average of corresponding values of column Value (Main sheet). If you need to take average of values from column Index, change rng.Cells(1, 1) to rng.Cells(1, 2)
Also note at this lines in UDF:
minI = .Max(1, i - 5)
maxI = .Min(rng.Rows.Count, i + 5)
if we can't take 5 values below and 5 values above index i (e.g. if index of target value equals to 2) we take in first case all values from start and in second case all values untill end of range.
Then you can call it either from worksheet: enter this formula in sheet Dash cell C4: =avrg(C3,Main!$C$6:$D$1126) and drag it across.
either from VBA:
Sub test()
Dim rng As Range
Dim rngInd As Range
Dim cell As Range
Set rng = ThisWorkbook.Worksheets("Main").Range("C6:D1126")
Set rngInd = ThisWorkbook.Worksheets("Dash").Range("C3:L3")
For Each cell In rngInd
cell.Offset(1).Value = avrg(cell.Value, rng)
Next cell
End Sub
In both cases function returns #N/A if indx value not found.
I have a moderately sized dataset in excel from which I wish to extract the maximum value of the values in Column B, but those that correspond only to cells in Column A that satisfy certain criteria.
The desired functionality is similar to that of SUMIF or COUNTIF, but neither of those return data that is necessary. There isn't a MAXIF function; how do I emulate one?
You can use an array formula.In the cell in which you want the max calculated enter: =Max(If([test],[if true],[if false]) where you replace the values in square brackets with the test, what to return if true and what to return if false. For example:
=MAX(IF(MOD(A2:A25,2)=0,A2:A25,0)
In this formula I return the value in column A if the value divided by 2 has no remainder. Notice that I use a range of cells in my comparison and in the value if false rather than a single cell.
Now, while still editing the cell, hit Ctrl+Shift+Enter (hold down the Ctrl key and the Shift together and then hit enter).
This creates an array formula that acts on each value in the range.
EDIT BTW, did you want to do this programmatically or manually? If programmatically, then what environment are you using? VBA? C#?
EDIT If via VBA, you need to use the FormulaArray property and R1C1 references like so:
Range("A1").Select
Selection.FormulaArray = "=MAX(IF(MOD(R[1]C:R[24]C,2)=0,R[1]C:R[24]C,0))"
Array formulas don't work very well when you want to use dynamic or named ranges (e.g., "the maximum amount due for rows above the current row that have the same counterparty as the current row). If you don't want to use an array formula, you can always resort to VBA to do something like this:
Function maxIfs(maxRange As Range, criteriaRange As Range, criterion As Variant) As Variant
maxIfs = Empty
For i = 1 To maxRange.Cells.Count
If criteriaRange.Cells(i).Value = criterion Then
If maxIfs = Empty Then
maxIfs = maxRange.Cells(i).Value
Else
maxIfs = Application.WorksheetFunction.Max(maxIfs, maxRange.Cells(i).Value)
End If
End If
Next
End Function
A limitation with the code provided thus far is that you are restricted to 2 conditions. I decided to take this code further to not restrict the number of conditions for the MaxIfs function. Please see the code here:
Function MaxIfs(MaxRange As Range, ParamArray Criteria() As Variant) As Variant
Dim n As Long
Dim i As Long
Dim c As Long
Dim f As Boolean
Dim w() As Long
Dim k As Long
Dim z As Variant
'Error if less than 1 criteria
On Error GoTo ErrHandler
n = UBound(Criteria)
If n < 1 Then
'too few criteria
GoTo ErrHandler
End If
'Define k
k = 0
'Loop through cells of max range
For i = 1 To MaxRange.Count
'Start by assuming there is a match
f = True
'Loop through conditions
For c = 0 To n - 1 Step 2
'Does cell in criteria range match condition?
If Criteria(c).Cells(i).Value <> Criteria(c + 1) Then
f = False
End If
Next c
'Define z
z = MaxRange
'Were all criteria satisfied?
If f Then
k = k + 1
ReDim Preserve w(k)
w(k) = z(i, 1)
End If
Next i
MaxIfs = Application.Max(w)
Exit Function
ErrHandler:
MaxIfs = CVErr(xlErrValue)
End Function
This code allows 1 to multiple conditions.
This code was developed with reference to multiple code posted by Hans V over at Eileen's Lounge.
Happy coding
Diedrich