I have a list of words and I would like to find all symmetric words and some how put value 1 for each of them (see the picture).
This does the trick:
=1*(A1=CONCAT(MID(A1,LEN(A1)-SEQUENCE(1,LEN(A1),0),1)))
It reads the string in a cell backwards using MID and SEQUENCE, and compares the CONCAT result with the original to see if it is the same, i.e. the string is symmetric.
Multiplying by 1 forces the Boolean into an integer.
With VBA. This assumes that a single character is symmetric:
Public Function Sym(s As String) As Long
Dim L As Long, L2 As Long
Dim p1 As String, p2 As String
L = Len(s)
L2 = Int(L / 2)
Sym = 0
If L Mod 2 = 0 Then
' even
p1 = Mid(s, 1, L2)
p2 = StrReverse(Mid(s, L2 + 1))
If p1 = p2 Then
Sym = 1
End If
Else
' odd
p1 = Mid(s, 1, L2)
p2 = StrReverse(Mid(s, L2 + 2))
If p1 = p2 Then
Sym = 1
End If
End If
End Function
This will handle both an even or odd number of characters.
EDIT#1:
Simply:
Public Function Sym(s As String) As Long
Sym = 0
If s = StrReverse(s) Then Sym = 1
End
With Microsoft365, try:
Formula in B1:
=EXACT(A1,CONCAT(MID(A1,SEQUENCE(LEN(A1),,LEN(A1),-1),1)))
Formula in C1:
=--EXACT(A1,CONCAT(MID(A1,SEQUENCE(LEN(A1),,LEN(A1),-1),1)))
If you are working in a version without CONCAT() it will get significatly more verbose, but still possible:
=SUMPRODUCT(--EXACT(MID(A1,ROW(A$1:INDEX(A:A,LEN(A1))),1),MID(A1,(LEN(A1)+1)-ROW(A$1:INDEX(A:A,LEN(A1))),1)))=LEN(A1)
This, again, can be wrapped to return either 1 or 0 if you prefer that over the boolean results:
=--(=SUMPRODUCT(--EXACT(MID(A1,ROW(A$1:INDEX(A:A,LEN(A1))),1),MID(A1,(LEN(A1)+1)-ROW(A$1:INDEX(A:A,LEN(A1))),1)))=LEN(A1))
The problem is pretty straight forward: convert the string representation into a number representing minutes. The only problem is that my code only works when I type the HH:MM:SS within a set of "". If the quotes are not included, the code runs but I get a #value error inside the cell in Excel. I figured this has to do with the length. With/without the quotes included, the code goes to the first index of the converted character array (or I should say the 0th). Here is my code:
Public Function TimeToDbl(val As String)
'Convert string into character array
Dim buff() As String
ReDim buff(Len(val) - 1)
For i = 1 To Len(val)
buff(i - 1) = Mid$(val, i, 1)
Next
'Separate hours,minutes,seconds
Dim h, m, s As Double
h = 0
m = 0
s = 0
For i = 1 To 2
h = (h * 10 ^ (i - 1)) + CInt(buff(i))
Next i
For i = 4 To 5
m = (m * 10 ^ (i - 4)) + CInt(buff(i))
Next i
For i = 7 To 8
s = (s * 10 ^ (i - 7)) + CInt(buff(i))
Next i
'Combine values centering minutes
s = s * 0.017
h = h * 60
m = h + m + s
TimeToInt = m
End Function
When passing a string with quotes, the quotes are included in the string. When the string is copied to an array, arr[0] becomes ". When passed without quotes, the text is still of type "string".
make a small change in the algorithm for h,m, and s shown below:
For i = 0 To 1
h = (h * (10 ^ i) + CInt(buff(i)))
Next i
I have an excel file where I loop over a matrix and want to calculate something for each cell within the matrix.
I do this with the following
Dim x, i As Integer
For x = 1 To 10
For i = 7 To 50
Cells(i, x).Formula = Dummy(optionType, S, 6750, T, r, b, v)
Next i
Next x
Where Dummy is a function that I wrote.
Function Dummy(optionType As String, S As Double, K As Double, T As Double, _
r As Double, b As Double, v As Double, Optional dS)
Dummy = 1
End Function
However, the problem is that within the file I also specify which function I want to use within the loop. This specification is located in cell A1. So for example, if A1 = 1 I want to use my own user-defined function function_1, 2 is my own-defined function function_2 etc. Importantly, for each cell the function is the same. So I need to specify this before the loop. Otherwise the macro will be slower than necessary, because it checks for each cell which value is located in A1. I tried the methodology from this Stackoverflow post by first using a simple dummy-variable and then run a new macro and replace the dummy-function with the specified functio. This doesn't work because the output of the Dummy-function is 1.
An example of possible function is
Function GammaBS(optionType As String, S As Double, K As Double, T As Double, _
r As Double, b As Double, v As Double, Optional dS)
Dim d1 As Double
d1 = (Log(S / K) + (r + v ^ 2 / 2) * T) / (v * Sqr(T))
GammaBS = (Application.WorksheetFunction.Norm_S_Dist(d1, False) * Exp((b - r) * T)) / (S * v * Sqr(T))
End Function
Question How can I re-use the defined functions as a new function in a macro?
I don't recommend writing VBA from VBA. There should be no reason to do this. You have to turn off some security settings that MS made to stop you from doing this. It's not safe.
If you just need a more dynamic formula then add more variables. Pass in the value from A1 as a parameter to the formula instead of trying to write a new formula. This will save you from corrupting your code.
Function GammaBS(optionType As String, S As Double, K As Double, T As Double, _
r As Double, b As Double, v As Double, Optional dS, Optional Aone)
If Aone = "the value you are looking for in A1" Then
`Do the thing you want this new function to do
I am currently working with arrays and loops, and am trying to write a function that will output an n by m array (a matrix) with the numbers {1, 2, 3, ... , n*m}
I am trying to learn some basic VBA code, this is purely for educational purposes.
This is what I have come up with:
Function createMatrix(n, m)
Dim matrix(1 To n, 1 To m) As Integer
x = 1
For i = 1 To n
For j = 1 To m
matrix(i, j) = x
x = (x + 1)
Next j
Next i
createMatrix = matrix
End Function
It returns #VALUE. I cannot understand why.
I got it to work at one point (creating a 3x3 matrix) by making it a function that did not take any variables and then initializing the matrix array by
Dim matrix(1 to 3, 1 to 3) As Integer
replacing n and m in the for loops with 3s.
So I guess the variables n and m are causing the problems, but don't know why.
Array declarations must be static (where the bounds are defined by a hardcoded value); however you can resize them dynamically using the ReDim statement.
' Declare an array.
' If you want to size it based on variables, do NOT define bounds.
Dim matrix() As Integer
' Resize dynamically.
ReDim maxtrix(n, m)
Note that when you ReDim, all values will be lost. If you had values in matrix that you wanted to keep, you can add the Preserve keyword:
ReDim Preserve matrix(n, m) ' Keep any existing values in their respective indexes.
You first need to declare array as dynamic array and then redim it to your dimension.
Function createMatrix(n, m)
Dim matrix() As Integer
ReDim matrix(1 To n, 1 To m) As Integer
x = 1
For i = 1 To n
For j = 1 To m
matrix(i, j) = x
x = (x + 1)
Next j
Next i
createMatrix = matrix
End Function
I have the following data:
cell(1,1) = 2878.75
cell(1,2) = $31.10
cell(2,1) = $89,529.13
However, when I tried to use round(cells(1,1).value*cells(1,2).value),2), the result does not match cell(2,1). I figured it has to do with the rounding issue, but I'm just wondering if it is possible to get round() to act normally. That is, for value > 0.5, round up. And for value < 0.5, round down?
VBA uses bankers rounding in an attempt to compensate for the bias in always rounding up or down on .5; you can instead;
WorksheetFunction.Round(cells(1,1).value * cells(1,2).value, 2)
If you want to round up, use half adjusting. Add 0.5 to the number to be rounded up and use the INT() function.
answer = INT(x + 0.5)
Try this function, it's ok to round up a double
'---------------Start -------------
Function Round_Up(ByVal d As Double) As Integer
Dim result As Integer
result = Math.Round(d)
If result >= d Then
Round_Up = result
Else
Round_Up = result + 1
End If
End Function
'-----------------End----------------
Try the RoundUp function:
Dim i As Double
i = Application.WorksheetFunction.RoundUp(Cells(1, 1).Value * Cells(1, 2).Value, 2)
I am introducing Two custom library functions to be used in vba, which will serve the purpose of rounding the double value instead of using WorkSheetFunction.RoundDown and WorkSheetFunction.RoundUp
Function RDown(Amount As Double, digits As Integer) As Double
RDown = Int((Amount + (1 / (10 ^ (digits + 1)))) * (10 ^ digits)) / (10 ^ digits)
End Function
Function RUp(Amount As Double, digits As Integer) As Double
RUp = RDown(Amount + (5 / (10 ^ (digits + 1))), digits)
End Function
Thus function Rdown(2878.75 * 31.1,2) will return 899529.12
and function RUp(2878.75 * 31.1,2) will return 899529.13
Whereas
The function Rdown(2878.75 * 31.1,-3) will return 89000
and function RUp(2878.75 * 31.1,-3) will return 90000
I had a problem where I had to round up only and these answers didnt work for how I had to have my code run so I used a different method.
The INT function rounds towards negative (4.2 goes to 4, -4.2 goes to -5)
Therefore, I changed my function to negative, applied the INT function, then returned it to positive simply by multiplying it by -1 before and after
Count = -1 * (int(-1 * x))
Math.Round uses Bankers rounding and will round to the nearest even number if the number to be rounded falls exactly in the middle.
Easy solution, use Worksheetfunction.Round(). That will round up if its on the edge.
Used the function "RDown" and "RUp" from ShamBhagwat and created another function that will return the round part (without the need to give "digits" for input)
Function RoundDown(a As Double, digits As Integer) As Double
RoundDown = Int((a + (1 / (10 ^ (digits + 1)))) * (10 ^ digits)) / (10 ^ digits)
End Function
Function RoundUp(a As Double, digits As Integer) As Double
RoundUp = RoundDown(a + (5 / (10 ^ (digits + 1))), digits)
End Function
Function RDownAuto(a As Double) As Double
Dim i As Integer
For i = 0 To 17
If Abs(a * 10) > WorksheetFunction.Power(10, -(i - 1)) Then
If a > 0 Then
RDownAuto = RoundDown(a, i)
Else
RDownAuto = RoundUp(a, i)
End If
Exit Function
End If
Next
End Function
the output will be:
RDownAuto(458.067)=458
RDownAuto(10.11)=10
RDownAuto(0.85)=0.8
RDownAuto(0.0052)=0.005
RDownAuto(-458.067)=-458
RDownAuto(-10.11)=-10
RDownAuto(-0.85)=-0.8
RDownAuto(-0.0052)=-0.005
This is an example j is the value you want to round up.
Dim i As Integer
Dim ii, j As Double
j = 27.11
i = (j) ' i is an integer and truncates the decimal
ii = (j) ' ii retains the decimal
If ii - i > 0 Then i = i + 1
If the remainder is greater than 0 then it rounds it up, simple. At 1.5 it auto rounds to 2 so it'll be less than 0.
Here's one I made. It doesn't use a second variable, which I like.
Points = Len(Cells(1, i)) * 1.2
If Round(Points) >= Points Then
Points = Round(Points)
Else: Points = Round(Points) + 1
End If
This worked for me
Function round_Up_To_Int(n As Double)
If Math.Round(n) = n Or Math.Round(n) = 0 Then
round_Up_To_Int = Math.Round(n)
Else: round_Up_To_Int = Math.Round(n + 0.5)
End If
End Function
I find the following function sufficient:
'
' Round Up to the given number of digits
'
Function RoundUp(x As Double, digits As Integer) As Double
If x = Round(x, digits) Then
RoundUp = x
Else
RoundUp = Round(x + 0.5 / (10 ^ digits), digits)
End If
End Function
The answers here are kind of all over the map, and try to accomplish several different things. I'll just point you to the answer I recently gave that discusses the forced rounding UP -- i.e., no rounding toward zero at all. The answers in here cover different types of rounding, and ana's answer for example is for forced rounding up.
To be clear, the original question was how to "round normally" -- so, "for value > 0.5, round up. And for value < 0.5, round down".
The answer that I link to there discusses forced rounding up, which you sometimes also want to do. Whereas Excel's normal ROUND uses round-half-up, its ROUNDUP uses round-away-from-zero. So here are two functions that imitate ROUNDUP in VBA, the second of which only rounds to a whole number.
Function RoundUpVBA(InputDbl As Double, Digits As Integer) As Double
If InputDbl >= O Then
If InputDbl = Round(InputDbl, Digits) Then RoundUpVBA = InputDbl Else RoundUpVBA = Round(InputDbl + 0.5 / (10 ^ Digits), Digits)
Else
If InputDbl = Round(InputDbl, Digits) Then RoundUpVBA = InputDbl Else RoundUpVBA = Round(InputDbl - 0.5 / (10 ^ Digits), Digits)
End If
End Function
Or:
Function RoundUpToWhole(InputDbl As Double) As Integer
Dim TruncatedDbl As Double
TruncatedDbl = Fix(InputDbl)
If TruncatedDbl <> InputDbl Then
If TruncatedDbl >= 0 Then RoundUpToWhole = TruncatedDbl + 1 Else RoundUpToWhole = TruncatedDbl - 1
Else
RoundUpToWhole = TruncatedDbl
End If
End Function
Some of the answers above cover similar territory, but these here are self-contained. I also discuss in my other answer some one-liner quick-and-dirty ways to round up.
My propose that is equal to Worksheetfunction.RoundUp
Function RoundUp(ByVal Number As Double, Optional ByVal Digits As Integer = 0) As Double
Dim TempNumber As Double, Mantissa As Double
'If Digits is minor than zero assign to zero.
If Digits < 0 Then Digits = 0
'Get number for x digits
TempNumber = Number * (10 ^ Digits)
'Get Mantisa for x digits
Mantissa = TempNumber - Int(TempNumber)
'If mantisa is not zero, get integer part of TempNumber and increment for 1.
'If mantisa is zero then we reach the total number of digits of the mantissa of the original number
If Mantissa <> 0 Then
RoundUp = (Int(TempNumber) + 1) / (10 ^ Digits)
Else
RoundUp = Number
End If
End Function
I got a workaround myself:
'G = Maximum amount of characters for width of comment cell
G = 100
'CommentX
If THISWB.Sheets("Source").Cells(i, CommentColumn).Value = "" Then
CommentX = ""
Else
CommentArray = Split(THISWB.Sheets("Source").Cells(i, CommentColumn).Value, Chr(10)) 'splits on alt + enter
DeliverableComment = "Available"
End If
If CommentX <> "" Then
'this loops for each newline in a cell (alt+enter in cell)
For CommentPart = 0 To UBound(CommentArray)
'format comment to max G characters long
LASTSPACE = 0
LASTSPACE2 = 0
If Len(CommentArray(CommentPart)) > G Then
'find last space in G length character string to make sure the line ends with a whole word and the new line starts with a whole word
Do Until LASTSPACE2 >= Len(CommentArray(CommentPart))
If CommentPart = 0 And LASTSPACE2 = 0 And LASTSPACE = 0 Then
LASTSPACE = WorksheetFunction.Find("þ", WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "þ", (Len(Left(CommentArray(CommentPart), G)) - Len(WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "")))))
ActiveCell.AddComment Left(CommentArray(CommentPart), LASTSPACE)
Else
If LASTSPACE2 = 0 Then
LASTSPACE = WorksheetFunction.Find("þ", WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "þ", (Len(Left(CommentArray(CommentPart), G)) - Len(WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "")))))
ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & Left(CommentArray(CommentPart), LASTSPACE)
Else
If Len(Mid(CommentArray(CommentPart), LASTSPACE2)) < G Then
LASTSPACE = Len(Mid(CommentArray(CommentPart), LASTSPACE2))
ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & Mid(CommentArray(CommentPart), LASTSPACE2 - 1, LASTSPACE)
Else
LASTSPACE = WorksheetFunction.Find("þ", WorksheetFunction.Substitute(Mid(CommentArray(CommentPart), LASTSPACE2, G), " ", "þ", (Len(Mid(CommentArray(CommentPart), LASTSPACE2, G)) - Len(WorksheetFunction.Substitute(Mid(CommentArray(CommentPart), LASTSPACE2, G), " ", "")))))
ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & Mid(CommentArray(CommentPart), LASTSPACE2 - 1, LASTSPACE)
End If
End If
End If
LASTSPACE2 = LASTSPACE + LASTSPACE2 + 1
Loop
Else
If CommentPart = 0 And LASTSPACE2 = 0 And LASTSPACE = 0 Then
ActiveCell.AddComment CommentArray(CommentPart)
Else
ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & CommentArray(CommentPart)
End If
End If
Next CommentPart
ActiveCell.Comment.Shape.TextFrame.AutoSize = True
End If
Feel free to thank me. Works like a charm to me and the autosize function also works!