Unable to compare Array element to String using InStr - vb6

I'm using VB6 and I'm trying to compare a string to an Array element. I know that if the string exists it will always be in index 0. Currently it always skips to End If. What am I doing wrong?
Dim attributeFinal As String,
strArray() As String,
stringFound As Integer,
code As String
attributes = "Material=10011,C=123123"
strArray = Split(attributes, ",")
If UBound(strArray) Then
code = strArray(0)
stringFound = InStr(1, "Material", code)
If stringFound <> 0 Then
attributeFinal = code & ",C=" & cCode
End If
End If

Solved thanks to #AndrewMorton. The arguments for comparing strings were in reverse order.
Dim attributeFinal As String,
strArray() As String,
stringFound As Integer,
code As String
attributes = "Material=10011,C=123123"
strArray = Split(attributes, ",")
If UBound(strArray) Then
code = strArray(0)
stringFound = InStr(code, "Material")
If stringFound <> 0 Then
attributeFinal = code & ",C=" & cCode
End If
End If

Related

unable to search character in a given string using VBScript?

I am trying to find whether the character is present in a given string or not but unable to search and increment value though it is present
Dim testchar,noOfSpecialChar
noOfSpecialChar=0
Dim specialChars
specialChars="*[#.^$|?#*+!)(_=-]."
for lngIndex = 1 to Len("test#123")
testchar = mid("test#123",lngIndex,1)
if((InStr(specialChars,testchar))) then
noOfSpecialChar=noOfSpecialChar+1
end if
next
The problem here is InStr() as highlighted in the documentation;
Returns the position of the first occurrence of one string within another.
We can use this knowledge to create a boolean comparison by checking the return value of InStr() is greater than 0.
Dim testString: testString = "test#123"
Dim testchar, foundChar
Dim noOfSpecialChar: noOfSpecialChar = 0
Dim specialChars: specialChars = "*[#.^$|?#*+!)(_=-]."
For lngIndex = 1 To Len(testString)
testchar = Mid(testString, lngIndex, 1)
'Do we find the character in the search string?
foundChar = (InStr(specialChars, testchar) > 0)
If foundChar Then noOfSpecialChar = noOfSpecialChar + 1
Next

how to remove leading zeroes from a string

I have to extract the integer value from a string.
Its actually an amount field.
Say string can be 000000000000512 or 0000040000000
I want only the integer value from this string i.e.; 512/ 40000000
Please help with this in VB scripting
CInt("000000000000512")
See conversion functions: http://msdn.microsoft.com/en-us/library/s2dy91zy.aspx
Use Clng if you expect to have large numbers, as already pointed out in a comment:
Clng("000000004000512")
otherwise you'll have an overflow, as variant's subtype int is 16 bit in vbscript
This will work even with a crazy long number
Function RemoveLeadingZeroes(ByVal str)
Dim tempStr
tempStr = str
While Left(tempStr,1) = "0" AND tempStr <> ""
tempStr = Right(tempStr,Len(tempStr)-1)
Wend
RemoveLeadingZeroes = tempStr
End Function
strNewFileName = RemoveLeadingZeroes("0009283479283749823749872392384")
Use the Absolute Value of the number.
http://ss64.com/vb/abs.html
Var = ABS(Var)
I've used this technique before:
replace the zeros with spaces
left trim
replace the spaces with zeros
Replace(LTrim(Replace(str, "0", " ")), " ", "0")
Note, this doesn't work if str has meaningful spaces in it.
Function TrimLeadingZeros(value)
TrimLeadingZeros = value
while left(TrimLeadingZeros, 1) = "0" and TrimLeadingZeros <> "0"
TrimLeadingZeros = mid(TrimLeadingZeros, 2)
wend
End Function
or
Function TrimLeadingZeros(value)
dim i
i = 1
while i < len(value) and mid(value,i,1) = "0"
i = i + 1
wend
TrimLeadingZeros = mid(value, i)
End Function
Using regex:
Regex.Replace("000000000000512", "^0+", "") ' returns "512"
Regex.Replace("0000040000000", "^0+", "") ' returns "40000000"
In case your string includes digits and characters, use a Do While statement:
string = "00000456ABC"
Do While Left(string, 1) = "0"
string = Right(string, (Len(string)-1))
Loop
Function TrimLZ(str)
If Left(str, 1) = "0" Then
TrimLZ = TrimLZ(Mid(str, 2, Len(str)))
Else
TrimLZ = str
End If
End Function

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