VBA Format Userform Numeric Output - vba

I have a spreadsheet/userform combo that takes user input to calculate product pricing/percent tax/and square footage in consideration to output a total cost for flooring in one of the userform's textboxes.
My userform is calculating everything correctly, but I am trying to figure out how to format the output box so that it only displays values up to two digits past the decimal (i.e. $1.00). Currently, it displays up to four digits or more beyond the decimal (as seen in the Total Area, Tax Amount, and Final Price text boxes).
My userform code is as follows (I left out some non-pertinent sections that had to do with opening and closing the userform but everything that has to do with the functioning of it is there):
Public Sub SumTool()
Dim A, B, C, D, E, F As Double
Dim x As Double
Dim finalSum As Double
Dim addUp As Double
Dim BeforePercent As Double
Dim Prcnt As Double
Dim percentALT As Double
Dim percentSum As Double
Dim i As Integer
addUp = 0
finalSum = 0
BeforePercent = 0
x = 0
i = 0
'These are all area measurements
A = 280
B = 118
C = 96
D = 243
E = 38
F = 83
Do While i < 1
'These are checks to see if checkboxes in the userform are True/False and
'correspond to the area measurements above
If LR.Value = True Then
x = x + A
Else
x = x
End If
If BR1.Value = True Then
x = x + B
Else
x = x
End If
If BR2.Value = True Then
x = x + C
Else
x = x
End If
If KT.Value = True Then
x = x + D
Else
x = x
End If
If BA.Value = True Then
x = x + E
Else
x = x
End If
If HALL.Value = True Then
x = x + F
Else
x = x
End If
i = i + 1
Loop
'I have different calculations because the user has the option of
'whether they want to include tax or not. If they do not (first option)
'no special conversions have to take place. If they do, the program has to
'take the entry and convert it from 5 or 10 to 0.05 or 0.10 and then carry
'forward with the rest of the operations
If Me.Y.Value = False Then
Prcnt = 0
addUp = x
finalSum = addUp * Me.ProductPrice.Value
Me.FinalResultsBox.Value = finalSum
Me.SqFtBox.Value = addUp
Me.TaxAmountValue.Value = 0
Else
Prcnt = Me.SalesTaxNumber.Value
addUp = x
percentALT = Prcnt * 0.01
BeforePercent = addUp * Me.ProductPrice.Value
percentSum = percentALT * BeforePercent
finalSum = BeforePercent + percentSum
Me.FinalResultsBox.Value = finalSum
Me.SqFtBox.Value = addUp
Me.TaxAmountValue.Value = percentSum
End If
End Sub

You may try something like this...
Me.FinalResultsBox.Value = Format(finalSum, "$0.00")

Related

VB.net Problem with If-statement not being run when the statement is true

With the following global variables:
Dim SpilleBræt(8, 8) As PictureBox
Dim Position(8, 8) As String
Dim MarkeretFelt(8, 8) As String
Dim FeltFarve As String
Dim x As Integer
Dim y As Integer
Dim AktivMarkering As Boolean = 0
Dim SpilleBrik As String
And this code:
Private Sub PictureBox_Click(ByVal sender As Object, ByVal e As EventArgs)
Dim FeltValg As PictureBox = CType(sender, PictureBox)
If AktivMarkering = 1 Then
x = Mid(sender.name, sender.name.Length - 1, 1)
y = Mid(sender.name, sender.name.Length, 1)
Select Case Position(y, x)
Case "LightTileMarked"
Me.SpilleBræt(y, x).BackgroundImage = My.Resources.ResourceManager.GetObject(SpilleBrik & "LightTile")
Case "DarkTileMarked"
Me.SpilleBræt(y, x).BackgroundImage = My.Resources.ResourceManager.GetObject(SpilleBrik & "DarkTile")
Case Else
'fjerner markerede
Select Case Position(y, x)
Case "BlackTower", "WhiteTower"
MsgBox("Tårn")
Case "BlackHorse", "WhiteHorse"
MsgBox("Hest")
Case "BlackBishop", "WhiteBishop"
MsgBox("Løber")
Case "WhiteKing", "BlackKing"
MsgBox("Konge")
Case "WhiteQueen", "BlackQueen"
MsgBox("Dronning")
Case "WhitePawn", "BlackPawn"
For k As Integer = y To 1 Step -1
If Position(k, x) = "" Then
If (k + x) Mod 2 = 1 Then
FeltFarve = "DarkTile"
Else
FeltFarve = "LightTile"
End If
Me.SpilleBræt(x, k).BackgroundImage = My.Resources.ResourceManager.GetObject(FeltFarve)
ElseIf Position(k, x) = "WhitePawn" Or Position(k, x) = "BlackPawn" Then
'background død brik
Else
k = 1
End If
Next
End Select
End Select
Else
'indsætter markering
'x,y i picturebox'ens navn fx ->(SpilBrik44) hvor x=4 og y=4
x = Mid(sender.name, sender.name.Length - 1, 1)
y = Mid(sender.name, sender.name.Length, 1)
Select Case Position(y, x)
Case "BlackTower", "WhiteTower"
MsgBox("Tårn")
Case "BlackHorse", "WhiteHorse"
MsgBox("Hest")
Case "BlackBishop", "WhiteBishop"
MsgBox("Løber")
Case "WhiteKing", "BlackKing"
MsgBox("Konge")
Case "WhiteQueen", "BlackQueen"
MsgBox("Dronning")
Case "WhitePawn", "BlackPawn"
For k As Integer = y To 1 Step -1
If Position(k, x) = "" Then
If (k + x) Mod 2 = 1 Then
FeltFarve = "DarkTileMarked"
Else
FeltFarve = "LightTileMarked"
End If
Me.SpilleBræt(x, k).BackgroundImage = My.Resources.ResourceManager.GetObject(FeltFarve)
MarkeretFelt(x, k) = FeltFarve
AktivMarkering = 1
ElseIf Position(k, x) = "WhitePawn" Or Position(k, x) = "BlackPawn" Then
'background død brik
Else
k = 1
End If
Next
End Select
End If
End Sub
I have a problem with the first If statement aktivmarkering=1, goes directly to the 'Else' even though if statements is true.
First time code is run, aktivmarkering is = 0, and therefore it obviously goes to 'Else', but after that one has ben run AktivMarkering is = 1, and first if should be executed. I don't see why not - anyone whos able to help?
Thanks.

VBA Split array

I have the following code:
Sub UpdateBlock()
'Define empty variables for each attribute
Dim ent As AcadEntity
Dim oBkRef As AcadBlockReference
Dim Insertpoints As Variant
Dim A As Double
Dim tag As String
Dim material As String
Dim actualLength As String
Dim cutOff As Double
Dim cutLengths As Double
Dim totalLengths As Double
Dim weight As Double
Dim purchaseLength As Double
Dim decimalLength As Double
Dim lengthWeight As Double
Dim totalLengthWeight As Double
Dim cutLengthWeight As Double
Dim cutWeight As Double
Dim order As Double
Dim feet As Double
Dim inches As Double
Dim fraction As Double
Dim fracVal As Variant
'First we go over every object in the modelspace
For Each ent In ThisDrawing.ModelSpace
'Check if the object is a block
If ent.ObjectName = "AcDbBlockReference" Then
Set oBkRef = ent
'If the object is a block then check if its the block we are looking for
If oBkRef.EffectiveName = "AUTOTAG-MATERIAL" Then
A = A + 1
'Get Current Attributes
attlist = oBkRef.GetAttributes
For i = LBound(attlist) To UBound(attlist)
Select Case attlist(i).TagString
Case "ACTUAL-LENGTH"
actualLength = attlist(i).TextString
Case "PURCHASE-LENGTH"
purchaseLength = attlist(i).TextString
Case "CUT-OFF"
cutOff = Frac2Num(attlist(i).TextString)
Case "DECIMAL-LENGTH"
feet = Split(actualLength)(0)
inches = Split(actualLength)(1)
fracVal = Split(actualLength)(2)
If Not IsNull(Split(actualLength)(2)) Then
fraction = Frac2Num(fracVal)
Else
fraction = 0
End If
decimalLength = Round((((feet * 12) + (inches + fraction)) / 12) - cutOff, 2)
attlist(i).TextString = decimalLength
Case "WEIGHT"
weight = attlist(i).TextString
Case "CUT-WEIGHT"
cutWeight = weight * decimalLength
attlist(i).TextString = cutWeight
Case "LENGTH-WEIGHT"
lengthWeight = weight * purchaseLength
attlist(i).TextString = lengthWeight
Case "TOTAL-LENGTHS"
totalLengths = attlist(i).TextString
Case "CUT-LENGTHS"
cutLength = attlist(i).TextString
Case "TOTAL-LENGTH-WEIGHT"
totalLengthWeight = lengthWeight * totalLengths
attlist(i).TextString = totalLengthWeight
Case "CUT-LENGTH-WEIGHT"
totalCutWeight = lengthWeight * cutLength
attlist(i).TextString = totalCutWeight
End Select
Next
End If
End If
Next ent
End Sub
Function Frac2Num(ByVal X As String) As Double
Dim P As Integer, N As Double, Num As Double, Den As Double
X = Trim$(X)
P = InStr(X, "/")
If P = 0 Then
N = Val(X)
Else
Den = Val(Mid$(X, P + 1))
If Den = 0 Then Error 11 ' Divide by zero
X = Trim$(Left$(X, P - 1))
P = InStr(X, " ")
If P = 0 Then
Num = Val(X)
Else
Num = Val(Mid$(X, P + 1))
N = Val(Left$(X, P - 1))
End If
End If
If Den <> 0 Then
N = N + Num / Den
End If
Frac2Num = N
End Function
The variable fraction / fracVal comes from a tag in AutoCAD that is a length, that will always be at least "0 0", but may be "0 0 0" it is a length in feet, inches, and fractional inches. So some possible values could be "8 5", "16 11 11/16", "0 5 3/8" etc.
What I need is a check for when the fraction is not there.
Any suggestions?
I would split the string on the space and see if the ubound of the resulting array is 2. So something like this
If Ubound(Split(thisString, " ")) = 2 then
'fractional part is present
End If
Another option is the Like Operator:
If thisString Like "#* #* #*/#*" Then
# matches any single digit (0–9) and * matches zero or more characters.
but since you split the string anyway, I would store the result of the split in a variable and check the number of items in it with UBound as shown in the other answer.

Add text to automatic labels and textboxes vb.net

The following code creates/formats labels and textboxes to a groupbox.
My problem is that i want to change the textbox text to 1 and 0 periodically ( like intercalated ), and i have no idea how to.
Private Sub ResizeData()
' Create as many textboxes as fit into window
grpData.Controls.Clear()
Dim x As Integer = 0
Dim y As Integer = 10
Dim z As Integer = 20
While y < grpData.Size.Width - 100
labData = New Label()
grpData.Controls.Add(labData)
labData.Size = New System.Drawing.Size(30, 20)
labData.Location = New System.Drawing.Point(y, z)
labData.Text = Convert.ToString(x + 1)
txtData = New TextBox()
grpData.Controls.Add(txtData)
txtData.Size = New System.Drawing.Size(50, 20)
txtData.Location = New System.Drawing.Point(y + 30, z)
txtData.TextAlign = System.Windows.Forms.HorizontalAlignment.Right
txtData.Tag = x
x += 1
z = z + txtData.Size.Height + 5
If z > grpData.Size.Height - 40 Then
y = y + 100
z = 20
End If
End While
End Sub
i need something like this:
txtData1.text="1"
txtData2.text="0"
txtData3.text="1"
txtData4.text="0"
...and so on.
Thank you!
Private Sub ResizeData()
' Create as many textboxes as fit into window
grpData.Controls.Clear()
Dim a As Integer = 1
Dim x As Integer = 1
Dim y As Integer = 10
Dim z As Integer = 20
While y < grpData.Size.Width - 100
Dim labData As New Label()
grpData.Controls.Add(labData)
labData.Size = New System.Drawing.Size(30, 20)
labData.Location = New System.Drawing.Point(y, z)
labData.Text = Convert.ToString(a)
Dim txtData As New TextBox()
grpData.Controls.Add(txtData)
txtData.Size = New System.Drawing.Size(50, 20)
txtData.Location = New System.Drawing.Point(y + 30, z)
txtData.TextAlign = System.Windows.Forms.HorizontalAlignment.Right
txtData.Tag = x
txtData.Text = x
a += 1
If x = 1 Then
x = 0
ElseIf x = 0 Then
x = 1
End If
z = z + txtData.Size.Height + 5
If z > grpData.Size.Height - 40 Then
y = y + 100
z = 20
End If
End While
End Sub
To give only the first 2 textboxes a value '1', use the same code above with these 3 lines modified:
Dim txtData As New TextBox() With {.Name = "txt" & a}
txtData.Text = 0
If txtData.Name = "txt1" Or txtData.Name = "txt2" Then txtData.Text = 1 'add this line just below the above one
Maybe using a boolean would work. Not the cleaner way but it should work
Where you dim everything:
Dim even as boolean
And after all the property changes of the txtData:
if even then
txtData.Text=1
else
txtData.Text=0
end if
even= not even

Items doesn't display in list box when I run the program

I was doing a program about Bisection Method. I haven't encountered any errors while doing the program, but when I run it, input the data, and press the compute button, no answer is displayed, but a scroll bar appears and freezes the program.
I don't know what is wrong but I guess it has something to do with logical error.
Public Class Form1
Dim a As Double
Dim b As Double
Dim c As Double
Dim fa As Double
Dim fb As Double
Dim fc As Double
Dim err As Double
Dim n As Integer = 1
Dim x As Double
Dim diserr As String
Dim fas As String
Dim fbs As String
Dim fcs As String
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
a = TextBox1.Text
b = TextBox2.Text
err = TextBox3.Text
fa = a ^ 3 - a - 3
fb = b ^ 3 - b - 3
c = (a + b) / 2
fc = c ^ 3 - c - 3
x = Math.Abs(a - b)
Do While x > err
fa = a ^ 3 - a - 3
fb = b ^ 3 - b - 3
c = (a + b) / 2
fc = c ^ 3 - c - 3
x = Math.Abs(a - b)
If err < x Then
diserr = "No"
Else
diserr = "Yes"
End If
If fa > 0 Then
fas = "+"
Else
fas = "-"
End If
If fb > 0 Then
fbs = "+"
Else
fbs = "-"
End If
If fc > 0 Then
fcs = "+"
Else
fcs = "-"
End If
If diserr = "Yes" Then
fcs = Str(x)
End If
ListBox1.Items.Add(Str(n))
ListBox2.Items.Add(Str(a))
ListBox3.Items.Add(Str(b))
ListBox4.Items.Add(Str(c))
ListBox5.Items.Add(Str(x))
ListBox6.Items.Add(diserr)
ListBox7.Items.Add(fas)
ListBox8.Items.Add(fbs)
ListBox9.Items.Add(fcs)
n = n + 1
If fas = "-" And fcs = "+" Then
b = c
End If
If fbs = "-" And fcs = "+" Then
a = b
b = c
End If
Loop
End Sub
End Class
You need to consider the cases where fcs is "-".
If I'm not misunderstanding the method you can just replace the last two ifs with
If fas <> fcs Then
b = c
Else
a = b
b = c
End If

Increment decimal place by 0.05 in Word VBA

I'll start off by saying i have jut started teaching myself VBA about a week ago, so I may not be asking the right question, but...
I am attempting to write a loop in Word VBA that will increment a number calculated partially from text retrieved from bookmarks. I want it to round up to the nearest .05, so .87 becomes .90 and .21 becomes .25.
The module that I have written follows:
A = ActiveDocument.Bookmarks("SRebateIncome").Range.Text
B = ActiveDocument.Bookmarks("RebateDefault").Range.Text
C = ((A - 6000) * 0.15)
D = B - C
E = B + D
F = (18200 + ((445 + E) / 0.19)) + 1
G = (0.19 * 18200) + 445 + E + (37000 * (0.015 + 0.325 - 0.19))
H = (G / (0.015 + 0.325)) + 1
I = ActiveDocument.Bookmarks("TRebateIncome").Range.Text
If F < 37000 = True Then
J = (0.125 * (I - F))
Else
J = (0.125 * (I - H))
End If
K = E - J
K = Format(Round(K, 2), "###,##0.00")
'round K up to the nearest .00 or .05
If K <> "###,###.#0" = False or K <> "###,###.#5") = False Then
Do
K = K + 0.01
Loop Until K = "###,###.#0" = True or K <> "###,###.#5") = True
End If
Set RebateOutput = ActiveDocument.Bookmarks("RebateOutput").Range
RebateOutput.Text = K
Now assuming that the value input for bookmarks "SRebateIncome", "RebateDefault" and "TRebateIncome" are 10175, 1602 and 43046 respectively, I expected the output to be 1460.80, but instead "K" is returned as 1460.78.
At this stage I don't know anything about using Excel within word (except copy/paste a spreadsheet into a document and I don't want to do that with this).
Any help would be appreciated
Thanks!
You can do it with an excel object and the Ceiling function
Option Explicit
Sub RoundText()
Dim dblSRebateIncome As Double
Dim dblRebateDefault As Double
Dim dblTRebateIncome As Double
Dim dblFinal As Double
Dim rngOutput As Range
Dim oExcel As Object
' Load the variables
Set oExcel = CreateObject("Excel.Application")
Set rngOutput = ActiveDocument.Bookmarks("RebateOutput").Range
dblSRebateIncome = CDbl(ActiveDocument.Bookmarks("SRebateIncome").Range.Text)
dblRebateDefault = CDbl(ActiveDocument.Bookmarks("RebateDefault").Range.Text)
dblSRebateIncome = CDbl(ActiveDocument.Bookmarks("TRebateIncome").Range.Text)
dblFinal = GetCalculatedValue(dblSRebateIncome, dblRebateDefault, dblTRebateIncome)
dblFinal = oExcel.worksheetfunction.Ceiling(dblFinal, 0.05)
rngOutput.Text = Format$(dblFinal, "###,##0.00")
End Sub
Function GetCalculatedValue(ByVal dblSIncome As Double, _
ByVal dblDefault As Double, _
ByVal dblTIncome) As Double
' Declare all the intermediate variables.
Dim c As Double, d As Double, e As Double
Dim f As Double, g As Double, h As Double
Dim j As Double, ret As Double
' Perform the complicated calculation
c = ((dblSIncome - 6000) * 0.15)
d = dblDefault - c
e = dblDefault + d
f = (18200 + ((445 + e) / 0.19)) + 1
g = (0.19 * 18200) + 445 + e + (37000 * (0.015 + 0.325 - 0.19))
h = (g / (0.015 + 0.325)) + 1
If f < 37000 Then
j = (0.125 * (dblTIncome - f))
Else
j = (0.125 * (dblTIncome - h))
End If
ret = e - j
' Return the value of the fucntion
GetCalculatedValue = ret
End Function
Hope this helps. :)
Dim x As Double
x = 1.111 'E.g.
Debug.Print Round(x * 20, 0)/20 '>> 1.10