I inserted a TextBox in my Userform. The user is expected to input an equation of the format x +/- y in one of the textboxes on the userform. So I need the value of this equation in a formula. That is
Dim Y As Double, yn1 As Double, X As Double, D As Double
Dim N As Integer, E As String
Y = Yn.Value ' value is from a textbox
X = Xn.Value ' value is from a textbox
D = StepSize.Value ' value is from a textbox
N = NSteps.Value ' value is from a textbox
E = Equation.value ' This is also from a textbox.
' This is where the prob is because this is a text string
For i = 1 To N
yn1 = Y + (E) * D ' E = X+Y
X = X + D
Y = yn1
ActiveSheet.Cells(i + 10, 4) = X
ActiveSheet.Cells(i + 10, 5) = Y
Next i
End Sub
This did not work because of equation.value. How do I go about it?
N.B: the values of X and Y are provided.
Use the Range.Formula property to set a formula. You can then use code like below to set the formula.
ActiveSheet.Cells(i+10,6).Formula = "=1+4"
You should be able to use Val() around your E variable to get the numerical value of the string.
Related
I'm wanting to build a conditional linear interpolation. I have over 31 unique identifiers. Where the range changes based on the identifier it selects. I was thinking I could do a select based on case criteria but that doesn't seem like the most efficient.
Data looks like this. (Where the currency is the identifier)
AED 1 4
AED 2 6
AUD 1 1
AED 3 12
AUD 2 6
AED 4 13
AUD 3 8
Below is the original linear interpolation formula.(Without any conditions). Any ideas what would be the best way to tackle this?
Function Linterp2(rX As Range, rY As Range, x As Double) As Double
' linear interpolator / extrapolator
' R is a two-column range containing known x, known y
Dim lR As Long, l1 As Long, l2 As Long
Dim nR As Long
'If x = 1.5 Then Stop
nR = rX.Rows.Count
If nR < 2 Then Exit Function
If x < rX(1) Then ' x < xmin, extrapolate
l1 = 1: l2 = 2: GoTo Interp
ElseIf x > rX(nR) Then ' x > xmax, extrapolate
l1 = nR - 1: l2 = nR: GoTo Interp
Else
' a binary search would be better here
For lR = 1 To nR
If rX(lR) = x Then ' x is exact from table
Linterp2 = rY(lR)
Exit Function
ElseIf rX(lR) > x Then ' x is between tabulated values, interpolate
l1 = lR: l2 = lR - 1: GoTo Interp
End If
Next
End If
Interp:
Linterp2 = rY(l1) _
+ (rY(l2) - rY(l1)) _
* (x - rX(l1)) _
/ (rX(l2) - rX(l1))
End Function
mmm "you want to build a conditional linear interpolation" and said "Say ID is AED" let me speculate what you really want,
First you have a Function (that do linear interpolate)
Second you have (for easy explain) a table that have 3 columns:
Column 1: ID (value that identify which ranges will use)
Column 2: Number of values have varibale X (range X)
Column 2: Number of values have varibale Y (range Y)
thats to mean if you select ID=AED, Function() will take a range.size for X and range.size for Y (for example taken first row you wrote only take AED)
1: you want "select case" insde your function if this is the case:
*first you select all columns for your ranges (select all column 2 for range X and select all column 3 for range y) and X value.
*then when your function runs; function have to identify Which ID have (you want to know)and resize your ranges X,Y and only take values that have ID like indentify.
So you need change variables in your Function because you need obligatorily a relationship between ID, X-value and y-value for each point.
so need a matrix
Function Linterp2(Mtr As Range, x As Double, ID as String) As Double
in this case your range have 3 columns and n rows (need to select all table)
then do a "For" where you search for ID in Range
dim MtrP(0,2)
for i=1 to mtr.rows.count
if MtrP(0,0)=nothing then /*get first value*/
if Mtr.cells(i,1).value="ID" then
MtrP(0,0)=Mtr.cells(i,1)
MtrP(0,1)=Mtr.cells(i,1)
MtrP(0,2)=Mtr.cells(i,1)
j=0
end if
elseif Mtr.cells(i,1).value="ID" then
j=j+1
redim preserve MtrP(j,2)
MtrP(j,0)=Mtr.cells(i,1)
MtrP(j,1)=Mtr.cells(i,1)
MtrP(j,2)=Mtr.cells(i,1)
end if
next
In this moment your new array with all data you need is MtrP and you can work with it for do your linear interpolate
Check this out,
Note that arrays are 0 indexed but ranges are 1 indexed.
Function Linterp3(rX As Range, rY As Range, rID As Range, x As Double, id As String) As Double
' Linear interpolator / extrapolator with index criteria
' Inputs:
' rX - 1 column range of x Values
' rY - 1 column range of y Values
' rID - 1 column range of index criteria
' x - x value criterion
' id - index criterion
' Select the relevant parts of the X,Y ranges based on the id criteria
Dim rX_selected() As Double, rY_selected() As Double, i As Integer, j As Integer
j = 0
For i = 1 To rX.Worksheet.UsedRange.Rows.Count
If rID.Cells(i).Value = id Then
ReDim Preserve rX_selected(j)
ReDim Preserve rY_selected(j)
rX_selected(j) = rX(i).Cells.Value
rY_selected(j) = rY(i).Cells.Value
j = j + 1
End If
Next
'Linearly interpolate
Dim lR As Long, l1 As Long, l2 As Long
Dim nR As Long
nR = j
If nR < 2 Then Exit Function
If x < rX_selected(0) Then ' x < xmin, extrapolate
l1 = 1: l2 = 2: GoTo Interp
ElseIf x > rX_selected(nR - 1) Then ' x > xmax, extrapolate
l1 = nR - 1: l2 = nR: GoTo Interp
Else
' a binary search would be better here
For lR = 1 To nR - 1
If rX_selected(lR) = x Then ' x is exact from table
Linterp3 = rY_selected(lR)
Exit Function
ElseIf rX_selected(lR) > x Then ' x is between tabulated values, interpolate
l1 = lR: l2 = lR - 1: GoTo Interp
End If
Next
End If
Interp:
Linterp3 = rY_selected(l1) _
+ (rY_selected(l2) - rY_selected(l1)) _
* (x - rX_selected(l1)) _
/ (rY_selected(l2) - rX_selected(l1))
End Function
I'm a newbie and I'm trying to learn VBA (Sorry for any mistake in English, I'm not a native speaker).
I am trying to solve the following assignment:
"Create a procedure that outputs the multiplication table values from 11 to 20 in Excel as shown below:"
multiplication table
This is my code:
Sub einmaleins()
Dim x As Integer, y As Integer
For x = 11 To 20
For y = 11 To 20
Cells(x, y) = x * y
Next
Next
End Sub
It works but puts the table from K11 to S20. I need it to enter the values from A1 to J10
I have tried
*Range("A1:J10").FormulaR1C1 = "=ROW(RC)*COLUMN(RC)"*
but it doesn´t work.
Help is greatly appreciated
In fact your formula approach is better as avoids a loop.
Range("A1:J10").FormulaR1C1 = "=(ROW(RC)+10)*(COLUMN(RC)+10)"
You can subtract 10 from each x and y coordinate.
For example, x = 11 and y = 11 would give cells(1, 1).
Sub einmaleins()
Dim x As Integer, y As Integer
For x = 11 To 20
For y = 11 To 20
Cells(x - 10, y - 10) = x * y
Next
Next
End Sub
Here you go if you want more control over the code and if you plan to use this repeatedly. It will not matter even if it is 11- 20 or any other number.
Also recommend that you refer the cell with the sheet reference so that when you go on you will have no issue with referencing. EG : Sheet1.Cells (y,x)
Here you go - The function.
Function einmaleins(fNumber As Integer, lNumber As Integer) As Integer
Dim x, y As Integer
For x = fNumber To lNumber
For y = fNumber To lNumber
Sheet1.Cells(x - (fNumber - 1), y - (fNumber - 1)) = x * y
Next
Next
End Function
//Call the function
Sub multiTable()
Call einmaleins(11, 20)
End Sub
Hope this helps
Tschüss
I'm struggling with a complex excel problem, and I would be amazed by any solution.
I have a table with 4 columns and the following values
The highest |13|12|12|12|
The two highest|11|12|11|11|
The two highest|12|12|12|12|
|12|11|11|11|
|12|11|11|11|
|12|11|11|11|
My problem requires from the first three rows to select the highest respectively the two highest values. Over the complete matrix there should be a sum of 12 values.
The required 5 plus whatever are the remaining 7 highest values. My current approach is to do a sum of the required rows and add the rest together, but that is obviouly not working.
|13|12|12|12|[MAX(B10:E10)]13|
|11|12|11|11|[LARGE(B11:E11;1)+LARGE(B11:E11;2)23|
|12|12|12|12|[LARGE(B12:E12;1)+LARGE(B12:E12;2)24|
|12|11|11|11|
|12|11|11|11|
|12|11|11|11|
Any ideas or suggestions are highly appreciated. Also a more understandable title for references would be great. Thanks!
Explanation:
It's sloppy VBA, but this works and the structure is generally expandable if you need it to be. You can just paste this in a VBA module, run Sum57(), and the result will be in the debug window (Ctl + G). To modify this for other array sizes, change the following :
the size of the used array in line 1
the values of arrR and arrC in lines 5 and 6 which define the start of the array
the pattern of the function calls in the body of Sum57()
The base pattern is:
For i = 1 To N
x = x + LargeOfRange([rStart], [rEnd], [cStart], [cEnd])
Next
where N is top N largest numbers from the range.
VBA:
Public used(5, 3) As Boolean
Public arrR, arrC As Integer
Public Sub Sum57()
arrR = 10
arrC = 2
For a = LBound(used, 1) To UBound(used, 1)
For b = LBound(used, 2) To UBound(used, 2)
used(a, b) = False
Next
Next
Dim x As Integer
x = x + LargeOfRange(10, 10, 2, 5)
For i = 1 To 2
x = x + LargeOfRange(11, 11, 2, 5)
Next
For i = 1 To 2
x = x + LargeOfRange(12, 12, 2, 5)
Next
For i = 1 To 7
x = x + LargeOfRange(10, 15, 2, 5)
Next
Debug.Print x
End Sub
Public Function LargeOfRange(rStart As Integer, rEnd As Integer, _
cStart As Integer, cEnd As Integer) As Integer
On Error GoTo SkipVal
Dim l, x, xR, xC As Integer
x = 0
For r = rStart To rEnd
For c = cStart To cEnd
If x < Cells(r, c).Value And used(r - arrR, c - arrC) = False Then
xR = r
xC = c
x = Cells(r, c).Value
End If
Next
Next
used(xR - arrR, xC - arrC) = True
LargeOfRange = x
Exit Function
SkipVal:
LargeOfRange = 0
End Function
Why not just extend the range and add more elements to the Large() calc?
=LARGE(B13:E15,1)+LARGE(B13:E15,2)+LARGE(B13:E15,3)+LARGE(B13:E15,4)+
LARGE(B13:E15,5)+LARGE(B13:E15,6)+LARGE(B13:E15,7)
This returns 80
I get error when I try to assign TextBox1 to variable X.
Sub TB1()
Dim X As TextBox
Dim Y As String
X = TextBox1
If Len(X) < 4 Then
Y = X
Do
Y = "0" & Y
Loop Until Len(Y) >= 4
X = Y
End If
End Sub
You've got a few issues. See comments for details in the code
Sub TB1()
Dim X As TextBox
Dim Y As String
Set X = Me.TextBoxes("Textbox 1")
'You need to have some sort of reference to get to the textbox.
'Me in this case is a worksheet object I tested in the Sheet1 module.
'It has a collection of textboxes which you can refer to by name. Click on your textbox in excel to see the name in the upper left corner.
'The `Set` syntax is necessary for objects
If Len(X.Text) < 4 Then
Y = X.Text
'Have to explicitly refer to the text in the textbox since it has other properties you can change like height and width
Do
Y = "0" & Y
Loop Until Len(Y) >= 4
X.Text = Y 'Explicitly refer to the textbox text again to reassign
End If
End Sub
I'm trying to figure the cleanest way of showing, as an example, an initial value say 300 as x and a critical path say 1.5 as y. Both of these values can change, via input on the sheet.
Together with these values we have a resource of a and b. In this scenario a will fill 200 cells within a row and b will fill 100.
As I alluded to before, x and y can change, say, if y is 2, a fills 150 and b fills 150. And if y is 1 then only a fills 300.
Currently i'm using If statements, but I feel this is messy and could potentially lead to endless code in order to cover every possible outcome and I'm in need of a better solution.
Here is a simplistic example of what I'm currently achieving:
Private Sub Example()
Dim ActiveWB As Worksheet
Set ActiveWB = ActiveWorkbook.Sheets("Sheet1")
Dim cell As Range
Dim a, b, x, y As Double
x = ActiveWB.Range("A1").Value
y = ActiveWB.Range("A2").Value
a = x / y
b = x - a
For Each cell In ActiveWB.Range(Cells(3, 1), Cells(3, a))
If (cell.Column >= 0) And (cell.Column <> x) Then
If (y = 1) And (a > 0) Then
cell.Value = "a"
a = a - 1
ElseIf (y > 1) And (y < 2) And (a > 0) Then
cell.Value = "a"
a = a - 1
If (b > 0) Then
cell.Offset(1, 0).Value = "b"
b = b - 1
End If
ElseIf (y >= 2) And (y < 2.5) And (a > 0) Then
cell.Value = "a"
a = a - 1
If (b > 0) Then
cell.Offset(1, 0).Value = "b"
b = b - 1
End If
'..... and so on......
End If
End If
Next cell
End Sub
Any suggestions would be much appreciated. Thank you for your time. Y.
First of all declaring types should be done for each variable separately:
Dim a, b, x, y As Double
Becomes:
Dim a As Double, b As Double, x As Double, y As Double
Or (this is what I prefer):
Dim a As Double
Dim b As Double
Dim x As Double
Dim y As Double
Second, if your a and b are only used for determining the range width, then they are preferably not of a floating point type. In stead use Integer (under 2^15) or Long:
Dim a As Integer
Dim b As Integer
Dim x As Double
Dim y As Double
Then your value assignment to a and b cannot stay the way they are now, but should read something like:
a = Int(x / y)
b = Int(x - a)
Then I hope your x and y values are restricted to values > 0 and x > y in your sheet. If not then first test for that in your script...
Now last (and your original question), you can assign a value to a complete range of cells if you like:
If a > 0 Then Range(Cells(3, 1), Cells(3, a)).Value = "a"
If b > 0 Then Range(Cells(4, 1), Cells(4, b)).Value = "b"
I dont understand why you take of 1 from a and b, so if that really add something, please elaborate a bit more on the general logic...
I probably don't completely understand the complexity, but based upon what you shared you can replace your for loop with the following to achieve the same result:
ActiveWB.Range(Cells(3, 1), Cells(3, a)).Value = "a"
If b > 0 then
ActiveWB.Range(Cells(4, 1), Cells(4, b)).Value = "b"
End If