I want to reduce the decimal length
text1.text = 2137.2198231578
From the above, i want to show only first 2 digit decimal number
Expected Output
text1.text = 2137.21
How to do this.
Format("2137.2198231578", "####.##")
I was about to post use Format() when I noticed p0rter comment.
Format(text1.text, "000.00")
I guess Int() will round down for you.
Been many years since I used VB6...
This function should do what you want (inline comments should explain what is happening):
Private Function FormatDecimals(ByVal Number As Double, ByVal DecimalPlaces As Integer) As String
Dim NumberString As String
Dim DecimalLocation As Integer
Dim i As Integer
Dim LeftHandSide As String
Dim RightHandSide As String
'convert the number to a string
NumberString = CStr(Number)
'find the decimal point
DecimalLocation = InStr(1, NumberString, ".")
'check to see if the decimal point was found
If DecimalLocation = 0 Then
'return the number if no decimal places required
If DecimalPlaces = 0 Then
FormatDecimals = NumberString
Exit Function
End If
'not a floating point number so add on the required number of zeros
NumberString = NumberString & "."
For i = 0 To DecimalPlaces
NumberString = NumberString & "0"
Next
FormatDecimals = NumberString
Exit Function
Else
'decimal point found
'split out the string based on the location of the decimal point
LeftHandSide = Mid(NumberString, 1, DecimalLocation - 1)
RightHandSide = Mid(NumberString, DecimalLocation + 1)
'if we don't want any decimal places just return the left hand side
If DecimalPlaces = 0 Then
FormatDecimals = LeftHandSide
Exit Function
End If
'make sure the right hand side if the required length
Do Until Len(RightHandSide) >= DecimalPlaces
RightHandSide = RightHandSide & "0"
Loop
'strip off any extra didgits that we dont want
RightHandSide = Left(RightHandSide, DecimalPlaces)
'return the new value
FormatDecimals = LeftHandSide & "." & RightHandSide
Exit Function
End If
End Function
Usage:
Debug.Print FormatDecimals(2137.2198231578, 2) 'outputs 2137.21
Looks fairly simple, but I must be missing something subtle here. What about:
Option Explicit
Private Function Fmt2Places(ByVal Value As Double) As String
Fmt2Places = Format$(Fix(Value * 100#) / 100#, "0.00")
End Function
Private Sub Form_Load()
Text1.Text = Fmt2Places(2137.2198231578)
End Sub
This also works in locales where the decimal point character is a comma.
Related
I want to divide a string into three parts. I am using following code.
dim length1 as string
dim length2 as string
dim lenght3 as string
length1=Mid$(Text1.text,1,30)
length2=Mid$(Text1.text,31,70)
length3=Mid$(Text1.text,71,100)
msgbox length1
msgbox lenght2
msgbox length3
msgbox 2 show me the length of 11,30. Why?
What I have tried:
What have wrong with my code? I know that Mid$ start at the left of the string.
I am assuming that you are wanting each string to be 10 characters long? Your problem appears to be that you keep changing the length of the string by 10.
Edit: Since OP provided more information in his comments, I updated code to accommodate request.
Sub Test()
Dim length1 As String
Dim length2 As String
Dim length3 As String
Dim divTot As Integer, leftOver As Integer
divTot = Len(text1.Text) / 3
leftOver = Len(text1.Text) - (divTot * 2)
length1 = Mid$(text1.Text, 1, divTot)
length2 = Mid$(text1.Text, divTot + 1, divTot)
length3 = Mid$(Text1.Text, (divTot * 2) + 1, leftOver)
MsgBox length1
MsgBox length2
MsgBox length3
End Sub
hi all i have this question as bellow
how capitalize full in one vb6 Vb6 string variable
‘example
‘my fullname
Dim fullname as string
Fullname = “abdirahman abdirisaq ali”
Msgbox capitalize(fullname)
it prints abdirahmanAbdirisaq ali that means it skips the middle name space even if I add more spaces its same .
this is my own code and efforts it takes me at least 2 hours and still .
I tired it tired tired please save me thanks more.
Please check my code and help me what is type of mistakes I wrote .
This is my code
Private Function capitalize(txt As String) As String
txt = LTrim(txt)
temp_str = ""
Start_From = 1
spacing = 0
For i = 1 To Len(txt)
If i = 1 Then
temp_str = UCase(Left(txt, i))
Else
Start_From = Start_From + 1
If Mid(txt, i, 1) = " " Then
Start_From = i
spacing = spacing + 1
temp_str = temp_str & UCase(Mid(txt, Start_From + 1, 1))
Start_From = Start_From + 1
Else
temp_str = temp_str & LCase(Mid(txt, Start_From, 1))
End If
End If
Next i
checkName = temp_str
End Function
It's far simpler than that. In VB6 you should use Option Explicit to properly type your variables. That also requires you to declare them.
Option Explicit
Private Function capitalize(txt As String) As String
Dim temp_str as String
Dim Names As Variant
Dim Index As Long
'Remove leading and trailing spaces
temp_str = Trim$(txt)
'Remove any duplicate spaces just to be sure.
Do While Instr(temp_str, " ") > 0
temp_str = Replace(temp_str, " ", " ")
Loop
'Create an array of the individual names, separating them by the space delimiter
Names = Split(temp_str, " ")
'Now put them, back together with capitalisation
temp_str = vbnullstring
For Index = 0 to Ubound(Names)
temp_str = temp_str + Ucase$(Left$(Names(Index),1)) + Mid$(Names(Index),2) + " "
Next
'Remove trailing space
capitalize = Left$(temp_str, Len(temp_str) - 1)
End Function
That's the fairly easy part. If you are only going to handle people's names it still needs more work to handle names like MacFarland, O'Connor, etc.
Business names get more complicated with since they can have a name like "Village on the Lake Apartments" where some words are not capitalized. It's a legal business name so the capitalization is important.
Professional and business suffixes can also be problematic if everything is in lower case - like phd should be PhD, llc should be LLC, and iii, as in John Smith III, would come out Iii.
There is also a VB6 function that will capitalize the first letter of each word. It is StrConv(string,vbProperCase) but it also sets everything that is not the first letter to lower case. So PhD becomes Phd and III becomes Iii. Where as the above code does not change the trailing portion to lower case so if it is entered correctly it remains correct.
Try this
Option Explicit
Private Sub Form_Load()
MsgBox capitalize("abdirahman abdirisaq ali")
MsgBox capitalize("abdirahman abdirisaq ali")
End Sub
Private Function capitalize(txt As String) As String
Dim Names() As String
Dim NewNames() As String
Dim i As Integer
Dim j As Integer
Names = Split(txt, " ")
j = 0
For i = 0 To UBound(Names)
If Names(i) <> "" Then
Mid(Names(i), 1, 1) = UCase(Left(Names(i), 1))
ReDim Preserve NewNames(j)
NewNames(j) = Names(i)
j = j + 1
End If
Next
capitalize = Join(NewNames, " ")
End Function
Use the VB6 statement
Names = StrConv(Names, vbProperCase)
it's all you need (use your own variable instead of Names)
I'm trying to make a program that can take the letters of a string and invert their case. I know that in vb.net there exists the IsUpper() command, but I don't know of such a thing in vb6.
What can I use in place of it?
Thanks!
Something like this should work:
Private Function Invert(strIn As String) As String
Dim strOut As String
Dim strChar As String
Dim intLoop As Integer
For intLoop = 1 To Len(strIn)
strChar = Mid(strIn, intLoop, 1)
If UCase(strChar) = strChar Then
strChar = LCase(strChar)
Else
strChar = UCase(strChar)
End If
strOut = strOut + strChar
Next
Invert = strOut
End Function
This loops through the supplied string, and extracts each character. It then tries to convert it to upper case and checks it against the extracted character. If it's the same then it was already upper case, so it converts it to lower case.
It handles non alpha characters just fine as UCase/LCase ignores those.
Ok so I've searched and searched and can't quite find what I'm looking for.
I have a workbook and what I'm basically trying to do is take the entries from certain ranges (Sheet1 - E4:E12, E14:E20, I4:I7, I9:I12, I14:I17, & I19:I21) and put them in a separate list on Sheet2. I then want the new list on Sheet2 to be sorted by how many times an entry appeared on Sheet1 as well as display the amount.
example http://demonik.doomdns.com/images/excel.png
Obviously as can be seen by the ranges I listed above, this sample is much smaller lol, was just having trouble trying to figure out how to describe everything and figured an image would help.
Basically I am trying to use VBA (the update would be initialized by hitting a button) to copy data from Sheet1 and put all the ranges into one list in Sheet2 that is sorted by how many times it appeared on Sheet1, and then alphabetically.
If a better discription is needed just comment and let me know, I've always been horrible at trying to describe stuff like this lol.
Thanks in advance!
Another detail: I cant have it search for specific things as the data in the ranges on Sheet1 may change. Everything must be dynamic.
I started out with this data
and used the following code to read it into an array, sort the array, and count the duplicate values, then output the result to sheet2
Sub Example()
Dim vCell As Range
Dim vRng() As Variant
Dim i As Integer
ReDim vRng(0 To 0) As Variant
Sheets("Sheet2").Cells.Delete
Sheets("Sheet1").Select
For Each vCell In ActiveSheet.UsedRange
If vCell.Value <> "" Then
ReDim Preserve vRng(0 To i) As Variant
vRng(i) = vCell.Value
i = i + 1
End If
Next
vRng = CountDuplicates(vRng)
Sheets("Sheet2").Select
Range(Cells(1, 1), Cells(UBound(vRng), UBound(vRng, 2))) = vRng
Rows(1).Insert
Range("A1:B1") = Array("Entry", "Times Entered")
ActiveSheet.UsedRange.Sort Range("B1"), xlDescending
End Sub
Function CountDuplicates(List() As Variant) As Variant()
Dim CurVal As String
Dim NxtVal As String
Dim DupCnt As Integer
Dim Result() As Variant
Dim i As Integer
Dim x As Integer
ReDim Result(1 To 2, 0 To 0) As Variant
List = SortAZ(List)
For i = 0 To UBound(List)
CurVal = List(i)
If i = UBound(List) Then
NxtVal = ""
Else
NxtVal = List(i + 1)
End If
If CurVal = NxtVal Then
DupCnt = DupCnt + 1
Else
DupCnt = DupCnt + 1
ReDim Preserve Result(1 To 2, 0 To x) As Variant
Result(1, x) = CurVal
Result(2, x) = DupCnt
x = x + 1
DupCnt = 0
End If
Next
Result = WorksheetFunction.Transpose(Result)
CountDuplicates = Result
End Function
Function SortAZ(MyArray() As Variant) As Variant()
Dim First As Integer
Dim Last As Integer
Dim i As Integer
Dim x As Integer
Dim Temp As String
First = LBound(MyArray)
Last = UBound(MyArray)
For i = First To Last - 1
For x = i + 1 To Last
If MyArray(i) > MyArray(x) Then
Temp = MyArray(x)
MyArray(x) = MyArray(i)
MyArray(i) = Temp
End If
Next
Next
SortAZ = MyArray
End Function
End Result:
Here is a possible solution that I have started for you. What you are asking to be done gets rather complicated. Here is what I have so far:
Option Explicit
Sub test()
Dim items() As String
Dim itemCount() As String
Dim currCell As Range
Dim currString As String
Dim inArr As Boolean
Dim arrLength As Integer
Dim iterator As Integer
Dim x As Integer
Dim fullRange As Range
Set fullRange = Range("E1:E15")
iterator = 0
For Each cell In fullRange 'cycle through the range that has the values
inArr = False
For Each currString In items 'cycle through all values in array, if
'values is found in array, then inArr is set to true
If currCell.Value = currString Then 'if the value in the cell we
'are currently checking is in the array, then set inArr to true
inArr = True
End If
Next
If inArr = False Then 'if we did not find the value in the array
arrLength = arrLength + 1
ReDim Preserve items(arrLength) 'resize the array to fit the new values
items(iterator) = currCell.Value 'add the value to the array
iterator = iterator + 1
End If
Next
'This where it gets tricky. Now that you have all unique values in the array,
'you will need to count how many times each value is in the range.
'You can either make another array to hold those values or you can
'put those counts on the sheet somewhere to store them and access them later.
'This is tough stuff! It is not easy what you need to be done.
For x = 1 To UBound(items)
Next
End Sub
All that this does so far is get unique values into the array so that you can count how many times each one is in the range.
I have a function which should calculate the sum in an array of cells. This function is called in another subroutine very often and therefore has to be real fast. First I used a for-loop to get the numbers but it was too slow. Then I wanted to use a worksheetfunction but this is not working for reasons unknown. Here is the code of the function:
Function CalcMD(rownumbers, colnumber)
Dim MMDRow As Integer
Dim SearchRange As String
Dim FirstAddress As Boolean
MMDRow = MMDRow()
FirstAddress = False
SearchRange = ""
'building the search range
For i = 0 To UBound(rownumbers)
If rownumbers(i) > 0 And rownumbers(i) < MMDRow Then
If FirstAddress = False Then
SearchRange = SearchRange & cells(rownumbers(i), colnumber).Address(False, False)
FirstAddress = True
Else
SearchRange = SearchRange & ";" & cells(rownumbers(i), colnumber).Address(False, False)
End If
End If
Next
CalcMD = WorksheetFunction.Sum(Range(SearchRange))
End Function
Is there a better/faster way to get this result?
Here is a try. The trickiest part is finding the last row you want to sum, I think this is where we should work if this first attempt doesn't solve your case.
Function CalcMD(rownumbers, colnumber)
Dim MMDRow As Integer, iMaxRow As Integer
Dim SearchRange As String
MMDRow = MMDRow()
'Find the last row where you want to sum the data
iMaxRow = WorksheetFunction.Min(MMDRow - 1, WorksheetFunction.Max(rownumbers))
CalcMD = WorksheetFunction.Sum(Cells(iMaxRow, colnumber))
End Function
Please also note that there aren't many error checking here (especially to check the input data)
Using JMax's approach:
Function CalcMD(rownumbers, colnumber)
Dim MMDRow As Integer, iMaxRow As Integer
Dim SearchRange As String
MMDRow = MMDRow()
'Find the last row where you want to sum the data
iMaxRow = WorksheetFunction.Min(MMDRow - 1, WorksheetFunction.Max(rownumbers))
CalcMD = WorksheetFunction.SumIF(Cells(iMaxRow, colnumber),">0")
End Function
Is that what you are looking for?