I want to loop through an entire column W2, while taking the average of each row. the column is 1326 long.
The code I have below only calculates the average of W2 and B2. Can someone help
NumCellsFromEdge = 3
Dim NumOfCells As Integer
NumOfCells = 3
MsgBox GetTopDrTS(NumCellsFromEdge, NumOfCells) & " = average of " & NumCellsFromEdge & " cells in, and " & NumOfCells & " cells wide"
End Sub
Function GetTopDrTS(L_NumCellsFromEdge As Integer, L_NumOfCells As Integer) As Double
Dim val As Double
Dim mycol As Double
val = 0
mycol = 23
'Range("W2").Select
'Columns(mycol).Select
Dim i As Integer
For i = 0 To L_NumOfCells - 1
Range("W2" & i).Select
val = val + Selection.Worksheet.Cells(Selection.Row, Selection.Column + EdgePos + L_NumCellsFromEdge + i).Value
Next i
GetTopDrTS = val / L_NumOfCells
End Function
This is all you need:
MsgBox [average(w:w)]
Application.average(sheets(1).range("E:E"))
will tell you the average of column E in sheets 1
Related
As a beginner, I would like to ask if it is possible in VBA to autofill formulas in a multidimensional array.
Ι thought and wrote this code and it works with values but not with formulas.
I think that what I am trying to do is very ambitious for my skills
Sub eucldiist()
Dim e(10,10) As Double, i As Integer, j As Integer
For i = 1 To 10
For j = 1 To 10
e(i, j).FormulaArray = "=sqrt((offset('Data1'!$Q$14,$BD$5(offset(i)) -
offset('Data1'!$Q$14,$BD$5(offset(j))^2+ ((offset('Data1'!$U$14,
$BD$5(offset(i))-OFFSET('Data1'!$U$14,$BD$5(offset(j)))^2)"
Next j
Next i
Sheets("Calculations").Select: Range("A20").Select
For i = 1 To 10
For j = 1 To 10
ActiveCell.Value = e(i, j)
ActiveCell.Offset(0, 1).Select
Next j
ActiveCell.Offset(1, -10).Select
Next i
End Sub
Is it possible what I am trying to do?
check this out. put some formulas in a20:j29 before hand
Option Explicit
Sub test()
Dim aaa As Variant
aaa = Range("a20").Resize(10, 10).Formula
Stop ' now examine aaa in "locals" window
' maybe all you want is this
range("a20").Resize(10,10).FormulaArray = "=SQRT((OFFSET(DATA1!Q14,BD5,0)-OFFSET(DATA1!Q14,BD7,0))^2+((OFFSET(DATA1!U14,BD5,0)-OFFSET(DATA1!U14,BD7,0))^2))"
End Sub
i think that this is what you want
NOTE: formula uses absolute addressing, so a column or row insert will break it
delete $ from formula to make it use relative addressing
Sub eucldiist()
Dim base As Range
Set base = Sheets("Calculations").Range("A20")
' Set base = ActiveSheet.Range("A20")
Dim formula As String
Dim i As Integer, j As Integer
For i = 0 To 9 ' rows
For j = 0 To 9 ' columns
formula = "=sqrt(" _
& " (offset('Data1'!$Q$14,$BD$" & 5 + i & ",0) - offset('Data1'!$Q$14,$BD$" & 7 + j & ",0))^2" _
& " + (offset('Data1'!$U$14,$BD$" & 5 + i & ",0) - offset('Data1'!$U$14,$BD$" & 7 + j & ",0))^2" _
& ")"
' Debug.Print formula
base.Offset(i, j) = formula
Next j
Next i
End Sub
I've written a function that essentially returns a weighted score by assigning values of 1 and 2 to different conditionally formatted cells. When I call this function in the worksheet, it returns the #VALUE! error.
Function ColorWeight(Factors As Range) As Integer
Dim x As Range
Dim score As Integer
score = 0
For Each x In Factors
If x.DisplayFormat.Interior.color = Range("C5").Interior.color Then
score = score + Cells(14, x.Column).Value * 2
ElseIf x.DisplayFormat.Interior.color = Range("C9").Interior.color Then
score = score + Cells(14, x.Column).Value * 1
End If
Next
ColorWeight = score
End Function
However, when I run this code as a sub and set the range to a specific range, as below, it works fine.
Sub ColorWeight()
Dim Factors As Range
Dim x As Range
Dim score As Integer
Set Factors = Range("G17:Q17")
score = 0
For Each x In Factors
If x.DisplayFormat.Interior.color = Range("C5").Interior.color Then
score = score + Cells(14, x.Column).Value * 2
ElseIf x.DisplayFormat.Interior.color = Range("C9").Interior.color Then
score = score + Cells(14, x.Column).Value * 1
End If
Next
Debug.Print score
End Sub
What is the difference that I'm missing that makes the function not work?
Here's a basic example of a work-around:
Function GetDFColor(shtName, cellAddress)
GetDFColor = ThisWorkbook.Sheets(shtName).Range(cellAddress). _
DisplayFormat.Interior.Color
End Function
'works when called as a UDF
Function DisplayFormatColor(rng As Range)
DisplayFormatColor = Application.Evaluate("GetDFColor(""" & _
rng.Parent.Name & """,""" & rng.Address() & """)")
End Function
So at Assign sheet I indicate the sheets to take data for each group (each for column and the first row is the explanation of the group). I dynamically can add res at the file or delete
After I use predefined codes to assign which type of discounts / day are applied. At the example I only put two codes (C and S) and one week. For example the raw sheet data for designations Red and Black.
Data product worksheet
Then at Diary I want to show the result of concatenate the B1 value (name of product) each time code fromm price are indicated into the rows. Also I use two loop because at raw product data I have one column for price but at the Diary I have two
Summary page
This is what I finally want to get and doing like that because my boss don't know anything for code and he wan't edite it so I try to do ll dynamic at the sheets :) [I only put two images because i don't have reputations point enough to put more]
With the formula I only get FALSE as answer :(, and I need to get what you can see at summary page
Sub Diary()
Dim I As Integer, x As Integer, y As Integer, z As Integer, n As Integer
Dim p As Integer, d As Integer, f As Integer
Dim a As String, b As String
Dim element As Variant
' Initialize variables I and y at 3 and 4 to begin to show the data at the column I desire. Also x and z were intended to pass the one column mode data sheet to the two column mode at the summary page.
I = 3
x = 1
y = 4
z = 0
With Worksheets("Asign")
.Activate
.Range("B2").Select
End With
' Set the size of Data with sheet names it get form the page assign. It can dynamically changed as size as names of sheets
With ActiveSheet
r = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
Dim Data() As String
ReDim Data(r)
For p = 1 To r - 1
Data(p) = ActiveSheet.Cells(p + 1, "B").Value
Next p
With Worksheets("Diary")
.Activate
.Range("C7").Select
End With
' At Diary concatenate the same cell for all the sheets I have his name stored at Data() and then pass to the next cell with data at raw data sheets (in the images (Red, Black ,... pages). In this case search for code S
Do
Cells(7, I).Select
ActiveCell.Value = ActiveCell.FormulaR1C1 = "=CONCATENATE(" & a & ")"
For Each element In Data
b = ActiveCell.FormulaR1C1 = "IF(Data& !R[-2]C[" & x & "]=""S"",CONCATENATE(Data&!R1C2,"", ""),"""")"
a = b & ";" & b
Next element
x = x - 1
I = I + 2
Loop While I < 4
' The same for the second column of summary sheet called Diary. In this case search for code C
Do
Cells(7, y).Select
ActiveCell.Value = ActiveCell.FormulaR1C1 = _
"=CONCATENATE(" & a & ")"
For Each element In Data
b = ActiveCell.FormulaR1C1 = "IF(Data& !R[-2]C[" & z & "]=""S"",CONCATENATE(Data&!R1C2,"", ""),"""")"
a = b & ";" & b
Next element
z = z - 1
y = y + 2
Loop While I < 4
' Drag and Drop the formula to all the sheet's cells you need
Range("C8:E8").Select
Selection.AutoFill Destination:=Range("C8:E10"), Type:=xlFillDefault
'
End Sub
try this. .... could be simplified by looping through "colors" .... black, red, etc
Sub Diary()
Dim red As Variant
red = Sheets("red").Range("d6:g12") ' put range data into an array for processing
Dim black As Variant
black = Sheets("black").Range("d6:g12")
Dim i As Integer
Dim j As Integer
Dim strC As String
Dim strS As String
For i = 1 To 7
For j = 1 To 4
strC = ""
strS = ""
If LCase(black(i, j)) = "c" Then strC = "Black"
If LCase(black(i, j)) = "s" Then strS = "Black"
If LCase(red(i, j)) = "c" Then
If Len(strC) > 1 Then strC = strC & ";"
strC = strC & "Red"
End If
If LCase(red(i, j)) = "s" Then
If Len(strS) > 1 Then strS = strS & ";"
strS = strS & "Red"
End If
Sheets("diary").Range("c7").Cells(i, j * 2 - 1) = strS
Sheets("diary").Range("c7").Cells(i, j * 2) = strC
Next j
Next i
End Sub
I have a column of cells. They need to be concatenated into a single string with multiple delimiters in between.
I need something like the result in column 2 from the values in column 1
Column 1 | column 2
a1 | 'a1'
a2 | 'a1';'a2'
a3 | 'a1';'a2';'a3'
a4 | 'a1';'a2';'a3';'a4'
a5 | 'a1';'a2';'a3';'a4';'a5'
Currently I use the following formula
Column 1 | Column 2
a1 | ="'"&a1&"'"&";"
a2 | =b1&"'"&a2&"'"&";"
a3 |
and copy it down the column B2.
Is there a VBA code that could help me do that. I did find some that would add a single delimiter ' between the cells but I could not modify it to add multiple delimiters.
It would be very helpful could share a VBA code for the same.
You can use the Join method in VBA with a given delimeter:
e.g.
someArray = Array("some", "words", "here")
Debug.Print "'" & Join(someArray, "';'") & "'"
'// will print:
'// 'some';'words';'here'
I know you asked for VBA, but you can do this with a formula:
In B2:
=IF(ROW()=2,TEXTJOIN(";",TRUE,"'"&B1,"'"&A2&"'"),TEXTJOIN(";",TRUE,B1,"'"&A2&"'"))
and drag down:
Or
In B1, use ="'"&A1&"'", then in B2 (and drag down):
=SUBSTITUTE(TEXTJOIN(";",TRUE,"'"&B1,"'"&A2&"'"),"'","",1)
You can achieve desired output using this formula:
=CONCATENATE(B2, " ; '", A3, "'")
First put value from cell A2 to B2 manually (using ="'" & A2 & "'" formula) and then paste this formula in cell B3 and drag it down.
Here is the result with updated formula:
UPDATE (Thanks to BruceWayne)
Enter the value in cell B2 using:
="'" & A2 & "'"
So it will take the first '
I would just do a simple loop like so.
Sub combineRows()
'start and end rows, assuming column A
Dim startRow, endRow As Integer
Dim myString, myAdd As String
startRow = 2
endRow = 6
For i = startRow To endRow
myAdd = "'" & Range("A" & i) & "'" & ";"
myString = myString + myAdd
Range("B" & i) = myString
Next i
End Sub
Here's my JoinRange function. It has a few more options than you're looking for.
Public Function JoinRange(rInput As Range, _
Optional sDelim As String = vbNullString, _
Optional sLineStart As String = vbNullString, _
Optional sLineEnd As String = vbNullString, _
Optional sBlank As String = vbNullString, _
Optional sQuotes As String = vbNullString, _
Optional IgnoreBlanks As Boolean = True) As String
Dim vaCells As Variant
Dim i As Long, j As Long
Dim lCnt As Long
Dim aReturn() As String
If rInput.Cells.Count = 1 Then
ReDim aReturn(1 To 1)
aReturn(1) = sQuotes & rInput.Value & sQuotes
Else
vaCells = rInput.Value
ReDim aReturn(1 To rInput.Cells.Count)
For i = LBound(vaCells, 1) To UBound(vaCells, 1)
For j = LBound(vaCells, 2) To UBound(vaCells, 2)
If Len(vaCells(i, j)) = 0 Then
If Not IgnoreBlanks Then
lCnt = lCnt + 1
aReturn(lCnt) = sQuotes & sBlank & sQuotes
End If
Else
lCnt = lCnt + 1
aReturn(lCnt) = sQuotes & vaCells(i, j) & sQuotes
End If
Next j
Next i
ReDim Preserve aReturn(1 To lCnt)
End If
JoinRange = sLineStart & Join(aReturn, sDelim) & sLineEnd
End Function
use it in B1 like
=JoinRange($A$1:A1,";")
and fill down.
For the sake of avoiding visual confusion, I will offer CHAR(39)&CHAR(59)&CHAR(39) in place of "';'".
In B1, use this:
=CHAR(39)&TEXTJOIN(CHAR(39)&CHAR(59)&CHAR(39), TRUE, A$1:A1)&CHAR(39)
Fill down.
... or if the end result is the only important thing,
=CHAR(39)&TEXTJOIN(CHAR(39)&CHAR(59)&CHAR(39), TRUE, A1:A5)&CHAR(39)
A single tick (aka single quote or ') is ASCII character 39 and a semi-colon is ASCII character 59.
I am running a MonteCarlo Simulation in Excel with VBA but I only receive #Name? errors in the respective cells. When I click into one of these cells, press F2 and then Return the error disappears and the value is properly calculated. What is wrong here?
This is the code line calculating the respective value:
ActiveCell.Formula = "=Start_Rate * EXP(NORM.S.INV(RAND())* Standard_Deviation * (" & i & " ^1/2)) "
And that is the entire code (if necessary):
Sub MC_Simulation()
Dim i As Integer
Dim k As Integer
Dim StartCell As Range
Dim start_row As Integer
Dim start_column As Integer
iterations = Worksheets("Run_MC").Range("MC_Simulations").Value
Duration = Worksheets("Run_MC").Range("Duration").Value
Mean = Worksheets("Run_MC").Range("Mean").Value
Start_Rate = Worksheets("Run_MC").Range("Start_Rate").Value
Standard_Deviation = Worksheets("Run_MC").Range("Standard_Deviation").Value
start_row = 15
start_column = 1
For i = 1 To Duration
For k = 1 To iterations
Worksheets("Run_MC").Cells(start_row, start_column + i).Select
Selection.Value = i
Worksheets("Run_MC").Cells(start_row + k, start_column).Select
Selection.Value = k
Worksheets("Run_MC").Cells(start_row + k, start_column + i).Select
ActiveCell.Formula = "=Start_Rate * EXP(NORM.S.INV(RAND())* Standard_Deviation * (" & i & " ^1/2)) "
'Selection.Value
Next k
Next i
End Sub
You need to take the VBA variables out of the quotations:
ActiveCell.Formula = "=" & Start_Rate & "*EXP(NORM.S.INV(RAND())*" & Standard_Deviation & "*(" & i & "^1/2))"