Excel VBA manipulate array data - excel

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.

Related

Assigning a specific cell from a Range to a variable VBA

Is there a way to store specific cells into new variables from a range in VBA? What I mean is...
Suppose I have set the data below to a range call "numbers".
Now in VBA, for each row I want to extract each individual cell value and assign each value to a different variable. And then repeat again for the next row.
I essentially want to the use the values in a given row to do something and then have it repeat again for the next row.
Does this make sense???
This is what I've been playing around with... but I don't get how to assign each cell from a given row to a new variable
Public Sub try()
Dim rng As Range
Dim row As Range
Dim cell As Range
Dim n As Double
Set rng = Range("numbers")
For Each row In rng.Rows
For Each cell In row.Cells
n = cell.value
Next cell
Next row
End Sub
Try this:
Dim numberArray As Variant
' this line will assign numbers inside the range to an array
numberArray = Range("numbers").Value2
' now you are able to access all numbers in you range through this array, like this:
MsgBox numberArray(1, 1) 'it will show 1
The way you are doing it right now doesn't make sense, since you are assigning all values to one variable n, so on every iteration of a loop previous value gets overwritten, resulting in n having last value in a range, which is 3.
Is there any particular reason you want to store any cell value in a new variable?
With a given range it would be very easy to just store your values in a Variant Array. In your example it would be something like:
Public Sub try()
Dim rng As Range
Dim dataArray as Variant
Set rng = Range("numbers")
dataArray = rng
debug.print dataArray(1, 2) 'This would print 7 in your example range
end sub
You could then easily loop through your Variant Array like this:
Dim i as Long, j as Long
For i = 1 To UBound(dataArray, 1) 'This will loop through each row
For j = 1 To UBound(dataArray, 2) 'This will loop through each column (cell in your row)
Debug.Print dataArray(i, j)
Next
Next
UBound() returns the length of the Array at the given dimension as the second parameter. I am just printing the values again since I do not know what exactly your intention is.

Create an array of evenly spaced numbers for non-empty cells in row

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

Checking colored cells using SUMPRODUCT

I am trying to count the number of colored cells (which also satisfy another condition).
My cells are as follows:
My intention is to count the cells where there is a 'B' and where the adjacent cells are green in color.
I also write a function as follows:
Function CheckColor(rng As Range) As Boolean
If rng.Interior.ColorIndex = 43 Then
CheckColor = True
Else
CheckColor = False
End If
End Function
I then use SUMPRODUCT function as follows:
=SUMPRODUCT(--(V40:V50="B");--CheckColor(W40:W50))
However, I get an error #VALUE!
UPDATE
I have modified my formula as follows:
Function CheckColor(rng As Range) As Variant
Dim arr As Variant
Dim n As Integer
ReDim arr(0 To rng.Count - 1) As Variant
n = 0
For Each cell In rng
If cell.Interior.ColorIndex <> 43 Then
bl = False
Else
bl = True
End If
arr(n) = bl
n = n + 1
Next cell
CheckColor = arr
End Function
And I use the formula as follows:
=SUMPRODUCT((V40:V50="B")*CheckColor(W40:W50))
The answer I get is 6, which is wrong.
The arrays for column ranges are a bit different Variant(1 To 11, 1 To 1)
Function CheckColor(rng As Range)
Dim arr()
ReDim arr(1 To rng.Count, 1 To 1)
' arr = rng.Value2 ' arr Type in the Locals window shows as Variant(1 To 11, 1 To 1)
For i = 1 To rng.Cells.Count
arr(i, 1) = rng.Cells(i, 1).Interior.ColorIndex = 43
Next i
CheckColor = arr
End Function
You can do this without VBA, but you'll need a 'helper' column.
Create a named range with the name CellColour and the formula =GET.CELL(63,Sheet1!$B1)
Using your example (assuming it starts in cell A1), enter this formula in cells C1:C11: =CellColour. By the looks of your screen shot it should return 43 for green.
You can then use this formula to count column A with green in column B:
=COUNTIFS($A$1:$A$11,"B",$C$1:$C$11,43)
Background colour: How to count cells in a range with a value less than another cell in excel?
Font colour: Excel formula to get cell color
Edit, correction
In the function, you give the funtion a range and compare it to a ColorIndex. That means you ask if the whole range have the colorindex not the cells between.
What you do would work if Excel automaticly reference the right cells and compare them to the value, but i wouldn't do that for you.
So there are different ways you actually can manage this. First you do it without vba like Darren Bartrup-Cook meantion, you can do it with a helper column and write it like
=If(V40="B";CheckColor(W40)
And count the with Countif the true values or you write it in VBA but then you need to loop trough the cells one by one like this:
For x = 1 to 50
If Cells(x,10).Value = "b" AND Cells(x,11).ColorIndex = 43 Then
counter = counter + 1
Next x
Endif

Select the top 10 maximum values

I need help writing a loop that finds the 10 highest values in column "F". For each of the 10 highest values that are selected, I want to paste that value (as well as the associated values in column C, D, and E) in another spreadsheet.
Thanks
The Aggregate function is designed to ignore error values (among other things). Here's a SUB Aggregate and Large to get a threashold to triggger your copy code
Sub GetTop10(r As Range)
Dim v As Variant
Dim t As Variant
Dim i As Long
' 14 = function LARGE
' 6 = ignore error values
' 10 = get 10'th largest value
t = Application.WorksheetFunction.Aggregate(14, 6, r, 10)
v = r
For i = 1 To UBound(v, 1)
If Not IsError(v(i, 1)) Then
If v(i, 1) >= t Then
' copy r.cells(i,-2).resize(1,4) to your other sheet
End If
End If
Next
End Sub

Randomly choose a value in one column subset by another column

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....

Resources