How do I divide a string into three parts? - vb6

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

Related

How can I invert the case of a string in VB6?

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.

Risk Game not displaying score

I'm doing an assignment for my class called "Risk!", the basis of it is that you start with 1000 points, and input a number to risk. You roll 2 dice. If it's even, you lose and the input is removed from score. If it's odd, you win and input is added to score. For some reason, the score isn't displayed correctly.
Private Sub cmdQuit_Click()
Unload Me
End Sub
Private Sub cmdRollDice_Click()
intNumOutput1 = Int(Rnd * 6) + 1
intNumOutput2 = Int(Rnd * 6) + 1
lblNumOutput1.Caption = intNumOutput1
lblNumOutput2.Caption = intNumOutput2
intBothOutputs = intNumOutput1 + intNumOutput2
If intBothOutputs Mod 2 > 0 Then
intScore = intScore + intNumInput
MsgBox "odd, win"
Else
intScore = intScore - intNumInput
MsgBox "even, lose"
End If
lblTotal.Caption = "Your new point total is " & intScore
End Sub
Private Sub Form_Load()
Randomize
Dim intScore As Integer
Dim intNumOutput1 As Integer
Dim intNumOutput2 As Integer
Dim intBothOutputs As Integer
Dim intNumInput As Integer
txtNumInput.Text = intNumInput
intScore = 1000
txtNumInput.Text = ""
lblNumOutput1.Caption = ""
lblNumOutput2.Caption = ""
End Sub
When you want to use variables in more than one method (e.g. sub, function), you declare the variables outside of any method.
Now, since you declared your variables inside Form_Load, you can't use them in cmdRollDice_Click or in any other method. So, what happens when you use them in a method other than the one they were declared in? Well, if you have Option Explicit statement on top of your code, you'll get a run-time error. If you don't (which is your current case), the variables will get initialized -with zero value- each time the method is called (note: they're now not the same variables that were declared in Form_Load).
Hence, you need to declare your variables on top of your file (before all functions/subs) like the following:
Dim intScore As Integer
Dim intNumOutput1 As Integer
Dim intNumOutput2 As Integer
Dim intBothOutputs As Integer
Dim intNumInput As Integer
' The rest of your code
Private Sub Form_Load()
End Sub
Private Sub cmdRollDice_Click()
End Sub
'
'
So, as a rule: you declare variables inside a method ONLY if you don't need to use them outside that method.
For more information about this, read Understanding the Scope of Variables
Hope that helps :)
For string concatenation its best practice to convert data types to string using cstr. e.g. CStr(intScore)
Add the event handler for txtNumInput. You have not assigned the value to intNumInput whenever button is clicked.
Try below.
Option Explicit
Private intScore As Integer
Private intNumOutput1 As Integer
Private intNumOutput2 As Integer
Private intBothOutputs As Integer
Private intNumInput As Integer
Private Sub cmdRollDice_Click()
Dim intNumOutput1 As Integer
Dim intNumOutput2 As Integer
Dim intBothOutputs As Integer
intNumOutput1 = Int(Rnd * 6) + 1
intNumOutput2 = Int(Rnd * 6) + 1
lblNumOutput1.Caption = intNumOutput1
lblNumOutput2.Caption = intNumOutput2
intBothOutputs = intNumOutput1 + intNumOutput2
If intBothOutputs Mod 2 > 0 Then
intScore = intScore + intNumInput
MsgBox "odd, win"
Else
intScore = intScore - intNumInput
MsgBox "even, lose"
End If
lblTotal.Caption = "Your new point total is " & CStr(intScore)
End Sub
Private Sub txtNumInput_Change()
If IsNumeric(txtNumInput.Text) Then
intNumInput = CInt(txtNumInput.Text)
End If
End Sub

Excel copy/sort data while counting/removing duplicates

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.

How to reduce the decimal length

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.

Convert hex value to a decimal value in VB6

How can I convert a hex value to a decimal value in VB6?
I'm trying just to see if this works:
Dim hexVal as string
hexVal = "#7B19AB"
clng("&H" & hexVal)
However, I'm getting "Type MisMatch" error.
Get rid of the # sign
Dim hexVal as string
hexVal = "7B19AB"
clng("&H" & hexVal)
Get rid of the number sign (#) in the hexVal string.
This should do it
Dim hexVal as String
hexVal = "#7B19AB"
Dim intVal as Integer
intVal = Val("&H" & Replace(hexVal, "#", ""))
Try It:
value=CDbl("&H" & HexValue)
or
value=CInt("&H" & HexValue) 'but range +- 32,768
Try it this way:
Print Hex(Asc(Text1.Text))
Be very carful.
Dim hexVal as string
hexVal = "FFFF"
clng("&H" & hexVal)
will return a value of -1 because it thinks your HEX value is signed.
See what happens with F00A, again it thinks its signed.
Replace the Clng with ABS.
Dim uzunluk as Integer
On Error Resume Next
uzunluk = Len(Text1.Text)
For i = 0 To uzunluk
Text1.SelStart = i
Text1.SelLength = 1
Print Hex(Asc(Text1.SelText))
Next i
Dim hexVal As String
Dim str As String
Dim uzunluk As Integer
On Error Resume Next
hexVal = "#7B19AB"
str = Replace(hexVal, "#", "")
Text1.Text = str
uzunluk = Len(Text1.Text)
For i = 0 To uzunluk
Text1.SelStart = i
Text1.SelLength = 1
Print Hex(Asc(Text1.SelText))
Next i

Resources