Related
I have 2 strings of numbers: like this:
Textbox1.Text = 1,2,3,4,5,6,7,8,9,11
Textbox2.Text = 11,9,8,7,6,5,4,3,2,1
I want to calculate, display in textbox3, their sum, + or - or * or /
all value from textbox1.text + all values from textbox2.text
Textbox3.Text = 12,11,11,11,11,11,11,11,11,12
I would like, though, and a specification where I can change the sign, instead of + being -, or / or * depending on my choice.
this code is a bit cumbersome, I would like to improve it with something simpler.
Dim str1 As String
'Set your string value
str1 = TxtBoxLstDrawsPlus.Text
Dim str2 As String
'Set your string value
str2 = TxtBoxLstDrawsMinus.Text
Dim strWords As String() = str1.Split(",")
Dim strWordsAAA As String() = str2.Split(",")
TextBox6.Text &= Val(strWords(0)) + Val(strWordsAAA(0)) & "," & Val(strWords(1)) + Val(strWordsAAA(1)) & "," & Val(strWords(2)) + Val(strWordsAAA(2)) & "," & Val(strWords(3)) + Val(strWordsAAA(3)) & "," & Val(strWords(4)) + Val(strWordsAAA(4)) & "," & Val(strWords(5)) + Val(strWordsAAA(5)) & "," & Val(strWords(6)) + Val(strWordsAAA(6)) & "," & Val(strWords(7)) + Val(strWordsAAA(7)) & "," & Val(strWords(8)) + Val(strWordsAAA(8)) & "," & Val(strWords(9)) + Val(strWordsAAA(9)) & "," & Val(strWords(10)) + Val(strWordsAAA(10)) & "," & Val(strWords(11)) + Val(strWordsAAA(11)) & "," & Val(strWords(12)) + Val(strWordsAAA(12)) & "," & Val(strWords(13)) + Val(strWordsAAA(13)) & "," & Val(strWords(14)) + Val(strWordsAAA(14)) & "," & Val(strWords(15)) + Val(strWordsAAA(15)) & "," & Val(strWords(16)) + Val(strWordsAAA(16)) & "," & Val(strWords(17)) + Val(strWordsAAA(17)) & "," & Val(strWords(18)) + Val(strWordsAAA(18)) & "," & Val(strWords(19)) + Val(strWordsAAA(19))
You can split the input strings (TextBox1.Text and TextBox2.Text), Zip the string arrays to produce a result array, and finally String.Join it in TextBox3:
Here's in one line:
TextBox3.Text = String.Join(",", TextBox1.Text.Split({","c}, StringSplitOptions.RemoveEmptyEntries).
Zip(TextBox2.Text.Split({","c}, StringSplitOptions.RemoveEmptyEntries),
Function(x, y) CInt(x) + CInt(y)))
You can use the same approach to do different arithmetic operations:
Dim opr As Char = "+"c '<- From your arithmetic operation selector like ComboBox.
TextBox3.Text = String.Join(",", TextBox1.Text.Split({","c}, StringSplitOptions.RemoveEmptyEntries).
Select(Function(x) CInt(x)).
Zip(TextBox2.Text.Split({","c}, StringSplitOptions.RemoveEmptyEntries).
Select(Function(y) CInt(y)),
Function(x, y)
Select Case opr
Case "-"c
Return x - y
Case "*"c
Return x * y
Case "/"c
Return x \ y
Case Else
Return x + y
End Select
End Function))
It'll be a good idea if you'd validate your inputs first:
Dim Arr1() = TextBox1.Text.Split({","c}, StringSplitOptions.RemoveEmptyEntries)
Dim Arr2() = TextBox2.Text.Split({","c}, StringSplitOptions.RemoveEmptyEntries)
Dim opr As Char = OprTextBox.Text.ElementAtOrDefault(0) 'A TextBox this time as another example.
Dim ValidOpr() As Char = {"+"c, "-"c, "*"c, "/"c}
If Arr1.Length <> Arr2.Length OrElse
Arr1.Any(Function(x) Not Integer.TryParse(x, Nothing)) OrElse
Arr2.Any(Function(x) Not Integer.TryParse(x, Nothing)) OrElse
Not ValidOpr.Contains(Opr) Then
MessageBox.Show("Excuse me ... !?!?")
Return
End If
'You have valid inputs. Proceed...
TextBox3.Text = String.Join(",", Arr1.Select(Function(x) CInt(x)).
Zip(Arr2.Select(Function(x) CInt(x)),
Function(x, y)
Select Case opr
Case "-"c
Return x - y
Case "*"c
Return x * y
Case "/"c
Return x \ y
Case Else
Return x + y
End Select
End Function))
Better yet, enum the arithmetic operations:
Public Enum ArithmeticOperations
Add
Subtract
Multiply
Divide
End Enum
.. and create a parameterized Function that returns the joined string.
'You name it...
Public Function GetCalcString(input1 As String,
input2 As String,
opr As ArithmeticOperations) As String
Dim Arr1() = input1.Split({","c}, StringSplitOptions.RemoveEmptyEntries)
Dim Arr2() = input2.Split({","c}, StringSplitOptions.RemoveEmptyEntries)
If Arr1.Length <> Arr2.Length OrElse
Arr1.Any(Function(x) Not Integer.TryParse(x, Nothing)) OrElse
Arr2.Any(Function(x) Not Integer.TryParse(x, Nothing)) Then
Return Nothing
End If
Return String.Join(",", Arr1.Select(Function(x) CInt(x)).
Zip(Arr2.Select(Function(x) CInt(x)),
Function(x, y)
Select Case opr
Case ArithmeticOperation.Subtract
Return x - y
Case ArithmeticOperation.Multiply
Return x * y
Case ArithmeticOperation.Divide
Return x \ y
Case Else
Return x + y
End Select
End Function))
End Function
Assuming that, the arithmetic operations are listed in a ComboBox in the same order:
Private Sub TheCaller()
TextBox3.Text = GetCalcString(TextBox1.Text,
TextBox12.Text,
CType(ComboBox1.SelectedIndex, ArithmeticOperations))
End Sub
My problem is very simple. this code works only on txtDraw (Letter) & Y.
Example: txtDrawA1, txtDrawA2, and so on. I want to make this code work as follows: txtDrawAA1, txtDrawAA2, replacing a character to be 2 characters.
This Code: Dim tbName = "txtDraw" & Chr(64 + x) & y
Private Sub txtDrawSum()
On Error Resume Next
For y = 1 To 8
Dim sum = 0
For x = 16 To 30
Dim tbName = "txtDraw" & Chr(64 + x) & y
sum += CInt(Tab3.TabPages(1).Controls(tbName).Text)
Next
TabControl2.TabPages(4).Controls("SumDrawA" & (0 + y)).Text = sum.ToString()
Next
End Sub
Well, the simple solution would just be to repeat Chr(64 + x) twice i.e.:
Dim tbName = "txtDraw" & Chr(64 + x) & Chr(64 + x) & y
but a better approach would be to use the String constructor:
Dim tbName = "txtDraw" & New String(Chr(64 + x), 2) & y
or Strings.StrDup:
Dim tbName = "txtDraw" & StrDup(2, Chr(64 + x)) & y
This is better because say suddenly you want to repeat the character 10 times, you wouldn't have to duplicate the code as in the first example.
As an aside, you might want to use string interpolation to clean up the concatenations:
Dim tbName = $"txtDraw {StrDup(2, Chr(64 + x))} {y}"
Try using the replace function.
OldString.ToString().Replace("txtDrawA","txtDrawAA")
Can someone help me with the below code?
I am trying to add a text "Valid" in Column "I" if Cells in Column E is not Blank and Column H is 0.00%. Column H is converted to Format Cells>Percentage>Decimal Places = 2.
I am getting the error message:
Runtime error "13": Type Mismatch.
in the line:
If (Range("E" & Y) <> "" And Range("H" & Y) = "0.00%" Then)
The full code is:
Sub My_Comments()
Dim X As Integer
Dim Y As Integer
Dim Z As Integer
For X = 2 To 10000
If IsError(Range("F" & X)) Then
Range("I" & X) = "Not Held"
End If
Next X
For Y = 2 To 10000
If Range("E" & Y) <> "" And Range("H" & Y) = "0.00%" Then
Range("I" & Y) = "Valid"
End If
Next Y
End Sub
You need to change the line
If Range("E" & Y) <> "" And Range("H" & Y) = "0.00%" Then)
with this:
If CStr(Range("E" & Y)) <> "" And Range("H" & Y).Text = "0.00%" Then '// .Text
Trim (in VBA for MS-Access 2010) does not remove vbCrLfs, only spaces. In the immediate window, I get
? Len(vbCrLf & "a" & vbCrLf & "b" & vbCrLf)
8
? Len(Trim(vbCrLf & "a" & vbCrLf & "b" & vbCrLf))
8
For spaces however:
? Len(" " & "a" & " " & "b" & " ")
5
? Len(Trim(" " & "a" & " " & "b" & " "))
3
How to make a trim that removes vbCrLFs on the ends only?
If you don't mind removing ALL new lines (and not just edges) you could just do:
myStr = Application.clean(Application.trim(myStr))
For imitating Trim function, you'd need to test each character in your string's edges:
Function TrimNewLines(mtStr As String) As String
Dim pattern As String, c As String
Dim i As Integer: i = 1
pattern = "[" & Chr(10) & Chr(13) & "]"
c = Mid(mtStr, i, 1)
Do While c Like pattern
i = i + 1
c = Mid(mtStr, i, 1)
Loop
mtStr = Mid(mtStr, i, Len(mtStr))
i = Len(mtStr)
c = Mid(mtStr, i, 1)
Do While c Like pattern
i = i - 1
c = Mid(mtStr, i, 1)
Loop
mtStr = Mid(mtStr, 1, i)
TrimNewLines = mtStr
End Function
This seems to have done the trick:
Public Function trimNewlinesAndSpaces(chaine As String) As String
chaine = Trim(chaine)
Do While (left(chaine, 2) = vbCrLf) Or right(chaine, 2) = vbCrLf
If left(chaine, 2) = vbCrLf Then
chaine = right(chaine, Len(chaine) - 2)
End Ifj
If right(chaine, 2) = vbCrLf Then
chaine = left(chaine, Len(chaine) - 2)
End If
chaine = Trim(chaine)
Loop
trimNewlinesAndSpaces = chaine
End Function
For didactic purposes I like to perform and display calculations in Excel. To display calculations I use the following VBA worksheet-function:
Function DisplayFormula(range_rng As Range) As String
Application.Volatile
If range_rng.HasArray Then
DisplayFormula = "<-- " & " {" & range_rng.FormulaArray & "}"
Else
DisplayFormula = "<-- " & " " & range_rng.FormulaArray
End If
End Function
This works, however, I'm stuck with the implementation of two modifications:
I would like to display the actual values that are called in range_rng.
I would like to display variables instead of the ranges. The variables would be assigned in a separate cell, next to the cell where they are called from (see graphic below).
Column "C" shows the (desired) output formats for DisplayFormula(B3):
You can try this brute force approach.
I can't say that this is optimized, but it can satisfy your two conditions above.
Function DisplayFormula2(r As Range, Optional o As Variant) As String
Dim a, b, z, x, y, w
Dim f As String, tf As String
Dim c As Range
Dim i As Integer
If IsMissing(o) Then o = 0
a = Array("+", "-", "/", "*", "%", "&", "^", "=", _
"<", ">", "<=", ">=", "<>", "(", ")")
f = r.FormulaArray: tf = f
For Each b In a
With Application.WorksheetFunction
tf = .Substitute(tf, b, "|")
End With
Next
z = VBA.Split(tf, "|")
For Each w In z
Debug.Print w
On Error Resume Next
Set c = Range(w)
On Error GoTo 0
If Not c Is Nothing Then
If IsArray(x) Then
ReDim Preserve x(UBound(x) + 1): x(UBound(x)) = w
ReDim Preserve y(UBound(y) + 1): y(UBound(y)) = c.Offset(0, o).Value2
Else
x = Array(w)
y = Array(c.Offset(0, o).Value2)
End If
End If
Set c = Nothing
Next
If IsArray(x) Then
For i = LBound(x) To UBound(x)
With Application.WorksheetFunction
f = .Substitute(f, x(i), y(i))
End With
Next
End If
DisplayFormula2 = IIf(r.HasArray, "<-- {" & f & "}", "<-- " & f)
End Function
By the way, I don't think you need to use .Volatile so I removed it.
It will recalculate as long as you set Calculation mode to Automatic.
Actual Formula in C3:C5:
C3: =DisplayFormula(B3)
C4: =DisplayFormula2(B4)
C5: =DisplayFormula2(B5,-1)
You can achieve that by changing the target cell to TEXT format. Try this:
Function DisplayFormula(range_rng As Range) As String
Application.Volatile
ActiveCell.NumberFormat = "#"
If range_rng.HasArray Then
DisplayFormula = "<-- " & " {" & range_rng.FormulaArray & "}"
Else
DisplayFormula = "<-- " & " " & range_rng.FormulaArray
End If
End Function