I have two problems about the fraction number in user form textbox.
How to retrieve a value from excel sheet and show it in the textbox with fraction. For example 0.5(sheet) will be shown as 1/2 (textbox). not all values are fraction, there are also value for integer
This is the code to retrieve the value from the sheet
Set ctlTXT = Me.SizeFrame.Controls.Add("Forms.TextBox.1")
ctlTXT.name = "OD" & counter
ctlTXT.value = Sheet2.Range("P" & findstart + counter - 1).value
ctlTXT.Left = 72
ctlTXT.Height = 15: ctlTXT.Width = 54
ctlTXT.Top = 45 + ((counter - 1) * 17 + 2)
How to return the fractional value inserted in the user form textbox using case select statement. From the code below, there is no value return when 1/2 or 3/4 inserted in textbox.
This is the code for case select
Select Case X
Case "1 / 2"
Y = 15
Case "3 / 4"
Y = 20
Case 2
Y = 40
End Select
Both of these code is not a complete code.
For the first one, you can try
ctlTXT.Value = WorksheetFunction.Text(Sheet2.Range("P" & findstart + counter - 1).Value, "#?/?")
Related
I have a form that has a field with Inventory On Hand called QOH. I have 30 fields, each one contains a daily requirement and there is one field for each day. The fields are D1 through D30. What I want to do is create a loop that deducts the requirements (D1 through D30) from the QOH until the QOH falls below zero. I am counting the number of days as it is looping y = y + 1 to come up with the number of days of coverage. I then will return the counted result into a field on the form
Private Sub PDS_AfterUpdate()
Dim w As Integer 'generate the appropriate field reference'
Dim y As Integer 'My counter (The Value) that I return to the form'
Dim z As Double 'Quantity On Hand QOH'
Dim a As String
Dim strFieldName As String
z = Me.P0 ' PO is the field that contains the QOH - Quantity On Hand
If z < 0 Then ' If the QOH is already below zero return a -1
y = -1
End If
If z >= 0 Then
Do Until z < 0
w = w + 1 'This is used to get the number to add to the field to get the correct field'
a = "D" & w ' I then add the number to the field which starts with D to get the field that I want
to pull the value from'
strFieldName = "me." & a
z = z - strFieldName '<--- This is where I am stuck how do I get the value from the field I am
referencing in order to subtract it from the QOH'
y = y + 1 'This is the counter that I return to the field in my form'
Loop
End If
Me.DOH = y ' the field that the result is passed to on the form'
End Sub
Try this:
Do Until z <= 0
w = w + 1
a = "D" & CStr(w)
z = z - Me(a).Value
y = y + 1
Loop
Two days of continual failure. I am using a barcode system which has a barcode scanner which scans a barcode of alpha-numeric text and places it into an ActiveX textbox. It enters the text one letter at a time, and upon the completion of the entire barcode, it matches up to a Case selection, which then deletes the text in the box to get ready for the next scan.
The issue I happen to be facing is inside of the textbox. For whatever reason, the text goes into the textbox and occasionally ~ (1 time in one hour or 0 times in 8 hours) it will not complete the case. The exact text inside of the textbox which matches one of the cases is not counted and stays inside the box. At this point, any future scans are appended to the end of the text inside of the box.
Below is a sample of the variables, a case, and one of the events occuring based on case selection.
Variables
Private Sub TextBox1_Change()
Dim ws As Worksheet, v, n, t, b, c, e, f, h, j, k, i1, i2, i3, i4
Set ws = Worksheets("Sheet1")
v = TextBox1.Value
n = 0
t = 0
b = 0
c = 0
e = 0
f = 0
h = 0
j = 0
k = 0
i1 = 0
i2 = 0
i3 = 0
i4 = 0
Case
Select Case v
Case "2 in x 16 ft R -1": n = 9
t = 1
b = 10
c = 1
e = 11
f = 6
g = "2 in x 16 ft"
h = 40
j = 0.296
k = 1
Stuff that is done based on case type
'n = Sets the column reference for waste - not used?
't = Sets the cutting station column to be used (1,2,3) for the sq yards, row, and column of last scanned item for each station
'b = Sets the row reference for adding cut rolls waste + regular row reference for cut rolls
'c = Sets the column reference for adding cut rolls waste + regular column refernce for cut rolls
'e = Sets the column reference for taking 1 master roll out
'f = Sets the row reference for taking 1 master roll out
'g = name of the item being used for the time stamp
'h = Number of rolls coming out of the master roll
'j = The amount of Sq yards in the cut roll (to be used for waste)
'k = Case Selection
'i1 = Count for Cutting Station 1 timestamp, row reference
'i2 = Count for Cutting Station 2 timestamp, row reference
'i3 = Count for Cutting Station 3 timestamp, row reference
'i4 = Count for Cutting Station 1 timestamp, row reference - not used in this worksheet
If k = 1 And t = 1 Then
'Cutter 1 items
ws.Cells(1, t) = b
ws.Cells(2, t) = c
ws.Cells(3, t) = j
ws.Cells(4, t) = b
ws.Cells(5, t) = c
ws.Cells(6, t) = f
ws.Cells(7, t) = h
ws.Cells(b, c) = ws.Cells(b, c) + h
' adding different number based on case
ws.Cells(f, e) = ws.Cells(f, e) - 1
' always subtracts 1 from certain range based on case
i1 = ws.Cells(1, 30)
Cells(i1, 19).Value = Format(Now, "mm/dd/yyyy AM/PM h:mm:ss")
Cells(i1, 20).Value = g
TextBox1.Activate
TextBox1.Value = ""
Remember the text enters in one character at a time until the entire barcodes information is passed into the ActiveX textbox.
I can set a max length, but upon the max length it stays in the textbox. If I set the textbox to "", the next character in the barcode starts again and the append issue continues.
Is there a way to not have the case selection start upon the entry of each single character? Is there a way to have the textbox delete the extra information. If you set it to delete something which does not match a case, then it will delete anything entered since it puts one character in at a time.
Best regards,
Ford
I have a nested for loop that is looking to take values in one row, generate a value based on an equation, then do the same for many rows following the first one, all while adding the value together.
Essentially, if row one has a value of 15, and row 2 and 3 return values of 10 and 12, the variable storing the total value (named genCost) will be 37.
I want to place the summed total values of genCost in a new sheet, separated by day, but when I run the code I get a Run-time 1004 error. I realize that this has something to do with the sheet that I am working on, and the sheet that I am trying to place the values into (the 2nd to last line in the code).
I understand my code may be ugly and simple, but can somebody help me troubleshoot this?
'Nested For loop for ALL OTHER DAYS of genCost...only 1 formula
For j = 2 To dayNumber
For i = 1 To increments
'IF(AND(U7=1,U6=0),R7,0)
If Cells(rowValue, 21) = 1 And Cells(rowValue - 1, 21) = 0 Then
ifValue = Cells(rowValue, 18)
Else
ifValue = 0
End If
'calculate value variable with second half of equation
value = (((Cells(rowValue, 23) * Cells(rowValue, 16) * (1 / 6)) + (Cells(rowValue, 25) * Cells(rowValue, 17) * (1 / 6)) + (Cells(rowValue, 21) * Cells(rowValue, 19) * (1 / 6)) + ifValue))
genCost = genCost + value
'set value and ifValue back to zero and step down one row and do again
value = 0
ifValue = 0
rowValue = rowValue + 1
Next i
Cells(3, j) = genCost
Dim genCostRefNum As Integer: genCostRefNum = 6
ThisWorkbook.Sheets(1).Range(Cells(genCostRefNum, 4)) = genCost
genCost = 0
Next j
Instead of this
ThisWorkbook.Sheets(1).Range(Cells(genCostRefNum, 4)) = genCost
write this
ThisWorkbook.Sheets(1).Cells(genCostRefNum, 4) = genCost
There is a default property of Cells statement, which is Value (same for Range). So your code was exactly
ThisWorkbook.Sheets(1).Range(Cells(genCostRefNum, 4).Value).Value = genCost
and after executing Cells something like:
ThisWorkbook.Sheets(1).Range(6).Value = genCost
It's good practice to always write complete statements and don't rely on default properties.
I have a method I wrote in a VBA module
Public Function calcAscentTime()
IDepth = CInt(Sheets("Fundies").Range("B47"))
T = 0
T = T + 1 ' Add 1 minute for emergency
D = Math.Round((IDepth / 10) * 10) 'Round to Ceiling of nearest 10
half_depth = Math.Round(((D / 2) / 10) * 10, 0) 'Get where our first stop is
T = T + Math.Round((((D - half_depth) / 30) / 2) * 2) ' Ascend to first stop at 30ft/min
T = T + (half_depth / 10) ' 1 minute for every stop thereafter
What this does is take a value from Cell B47 on the "Fundies" worksheet and should return a value based on the calculations. I enter =calcAscentTime() into cell B48, expecting to get a value of 8(B47's value is 100), but get a return value of 0. What am I doing wrong?
ou're function isn't returning anything. Assigning the function name to the calculated variable should return the expected result (assuming you have everything else right). Something like:
Public Function calcAscentTime()
IDepth = CInt(Sheets("Fundies").Range("B47"))
T = 0
T = T + 1 ' Add 1 minute for emergency
D = Math.Round((IDepth / 10) * 10) 'Round to Ceiling of nearest 10
half_depth = Math.Round(((D / 2) / 10) * 10, 0) 'Get where our first stop is
T = T + Math.Round((((D - half_depth) / 30) / 2) * 2) ' Ascend to first stop at 30ft/min
T = T + (half_depth / 10) ' 1 minute for every stop thereafter
calcAscentTime = T
End Function
Keep in mind, you should probably Dim your variables to the proper type to avoid any kind of confusion / miss-casting by the compiler.
This function goes through all integers and picks out binary values with only five ones and writes them to the spreadsheet.
To run this For x = 1 To 134217728 would take 2.5 days!!!! Help!
How could I speed this up?
Function D2B(ByVal n As Long) As String
n = Abs(n)
D2B = ""
Do While n > 0
If n = (n \ 2) * 2 Then
D2B = "0" & D2B
Else
D2B = "1" & D2B
n = n - 1
End If
n = n / 2
Loop
End Function
Sub mixtures()
Dim x As Long
Dim y As Integer
Dim fill As String
Dim mask As String
Dim RowOffset As Integer
Dim t As Date
t = Now
fill = ""
For x = 1 To 134217728
mask = Right(fill & CStr(D2B(x)), Len(fill & CStr(D2B(x))))
Debug.Print mask
If x > 100000 Then Exit For
If Len(mask) - Len(WorksheetFunction.Substitute(mask, "1", "")) = 5 Then _
RowOffset = RowOffset + 1
For y = 1 To Len(mask)
If Len(mask) - Len(WorksheetFunction.Substitute(mask, "1", "")) = 5 Then _
Range("mix").Offset(RowOffset).Cells(y) = Mid(mask, y, 1)
Next
Next
Debug.Print DateDiff("s", Now, t)
End Sub
By first sight guess, I think the problem lies in the fact that you do that cell by cell, which causes many read and write accesses.
You should do it range by range, like
vArr = Range("A1:C1000").Value
' it is array now, do something here effeciently
Range("A1:C1000").Value = vArr
You want find all 28bit numbers with 5 1s
There are 28*27*26*25*24/5/4/3/2=98280 such numbers
The following code took ~10 seconds on my PC:
lineno = 1
For b1 = 0 To 27
For b2 = b1 + 1 To 27
For b3 = b2 + 1 To 27
For b4 = b3 + 1 To 27
For b5 = b4 + 1 To 27
Cells(lineno, 1) = 2 ^ b1 + 2 ^ b2 + 2 ^ b3 + 2 ^ b4 + 2 ^ b5
lineno = lineno + 1
Next
Next
Next
Next
Next
mask = Right(fill & CStr(D2B(x)), Len(fill & CStr(D2B(x))))
The above line of code does the same thing (CStr(D2B(x))) twice.
Store the result of CStr(D2B(x)) in a variable & use that variable in the above line of code.
I've got 2 suggestions:
Get rid of the substitution command by counting the ones/zeroes in D2B and return an empty string if the count does not equal 5
Write these pre-filtered bitstrings to an array first and copy the array directly to the cells when finished.
Something like
ws.Range(ws.cells(1, 1), ws.cells(UBound(dstArr, 1) + 1, UBound(dstArr, 2) + 1)) = dstArr
The array-copy-trick greatly improves performance!