richTextBox1.Text = "Where there is a will there is way";
I just want to change the both is only red color.
I know how to change the first is, but i don't know how to change the second is.
RichTextBox1.SelStart = RichTextBox1.Find("is")
RichTextBox1.SelLength = 2
RichTextBox1.SelColor = vbRed
According to the MSDN Article:
If the text searched for is found, the Find method highlights the
specified text and returns the index of the first character
highlighted. If the specified text is not found, the Find method
returns 1.
I'm assuming it's a typo and the return is -1 rather than 1 if the text isn't found, so, in your code:
Dim idx As Integer
Dim start As Integer
Do
idx = RichTextBox1.Find("is", start) '// First time through start at beginning
If idx = -1 Then Exit Do
RichTextBox1.SelStart = idx
RichTextBox1.SelLength = 2
RichTextBox1.SelColor = vbRed
start = idx + 1 '// Set the start for .Find to the next character
Loop
RichTextBox1.SelLength = 0 ' Clear the selection
Related
I would like to dynamically set some textbox values with database values.
I have tried to use something similar to below but I get the following compile error:
Can't assign to read only property. The .name = is highlighted.
Is it possible to assign the textbox values in this manner?
Dim x As Integer
For x = 1 To 30
Form1.RS.Fields(x).Name = RS.Fields(x).Value
Next
You can try using controls collection of the form :
Dim x As Integer
For x = 1 To 30
Form1.Controls(RS.Fields(x).Name).Text = RS.Fields(x).Value
Next
As a takeoff on Eddi's answer, here's code that allows for multiple control types on the form:
Dim x As Integer
For x = 1 To 30
If TypeOf Me.Controls(RS.Fields(x).Name) Is TextBox Then
Me.Controls(RS.Fields(x).Name).Text = RS.Fields(x).Value
ElseIf TypeOf Me.Controls(RS.Fields(x).Name) Is CheckBox Then
Me.Controls(RS.Fields(x).Name).Value = _
IIf(RS.Fields(x).Value = 1, vbChecked, vbUnchecked)
End If
Next
One shortcoming of the above code is the loss of intellisense. You can structure the code like the following so it is strongly-typed, which has a number of benefits including intellisense:
Dim tb As TextBox
Dim cb As CheckBox
Dim x As Integer
For x = 1 To 30
If TypeOf Me.Controls(RS.Fields(x).Name) Is TextBox Then
Set tb = Me.Controls(RS.Fields(x).Name)
tb.Text = RS.Fields(x).Value
ElseIf TypeOf Me.Controls(RS.Fields(x).Name) Is CheckBox Then
Set cb = Me.Controls(RS.Fields(x).Name)
cb.Value = IIf(RS.Fields(x).Value = 1, vbChecked, vbUnchecked)
End If
Next
Assuming you have an array of Text1 textboxes indexed from 1 to 30, you can use:
Dim iCounter As Integer
For iCounter = 1 To 30
' Check that counter is within the bounds of the Text1 array
If iCounter >= Text1.LBound And iCounter <= Text1.UBound Then
Text1(iCounter).Text = RS.Fields(iCounter).Value
End If
Next
There's extra code here to check that the counter is within the range of the Text1 array. The Text1 array could be gaps (missing items) in between its LBound and UBound values so it's not perfect. For example you could delete Text1(13) and still have LBound = 1 and UBound = 30. The easiest way is to check for error '340', if you decide to add that. Since you are building the UI you can simply remove any gaps.
Using an array of Textbox controls lets you share common code like the following, which highlights the text when the cursor enters the textbox:
Private Sub Text1_GotFocus(Index As Integer)
With Text1(Index)
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
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
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 list of items in an Excel worksheet, A1-B115. At the moment I can enter 10 variables which retrieves the correct data from the list.
Code now:
C1=1 - run through A1-A115 and check for the value to be between 1000-2000; if so, copy the B value somewhere.
C2=1 - run through A1-A115 and check for the value to be between 2001-3000; if so, copy the B value somewhere.
....
What I would like to do is that I can enter a value (example: 25 or 30) and that my macro randomly selects the right amount of values.
Code I would like to do: C1: 30 -> randomly selects 30 values from B1-B115
This will do the trick.
Sub PickRandomItemsFromList()
Const nItemsToPick As Long = 10
Const nItemsTotal As Long = 115
Dim rngList As Range
Dim varRandomItems() As Variant
Dim i As Long
Set rngList = Range("B1").Resize(nItemsTotal, 1)
ReDim varRandomItems(1 To nItemsToPick)
For i = 1 To nItemsToPick
varRandomItems(i) = rngList.Cells(Int(nItemsTotal * Rnd + 1), 1)
Next i
' varRandomItems now contains nItemsToPick random items from range rngList.
End Sub
As discussed in the comments, this will allow individual items to be picked more than once within the nItemsToPick picked, if for example number 63 happens to be randomly picked twice. If you don't want this to happen, then an additional loop will have to be added to check whether the item about to be picked is already in the list, for example like so:
Sub PickRandomItemsFromList()
Const nItemsToPick As Long = 10
Const nItemsTotal As Long = 115
Dim rngList As Range
Dim idx() As Long
Dim varRandomItems() As Variant
Dim i As Long
Dim j As Long
Dim booIndexIsUnique As Boolean
Set rngList = Range("B1").Resize(nItemsTotal, 1)
ReDim idx(1 To nItemsToPick)
ReDim varRandomItems(1 To nItemsToPick)
For i = 1 To nItemsToPick
Do
booIndexIsUnique = True ' Innoncent until proven guilty
idx(i) = Int(nItemsTotal * Rnd + 1)
For j = 1 To i - 1
If idx(i) = idx(j) Then
' It's already there.
booIndexIsUnique = False
Exit For
End If
Next j
If booIndexIsUnique = True Then
Exit Do
End If
Loop
varRandomItems(i) = rngList.Cells(idx(i), 1)
Next i
' varRandomItems now contains nItemsToPick unique random
' items from range rngList.
End Sub
Note that this will loop forever if nItemsToPick > nItemsTotal !
I would use a collection to make sure you don't get any duplicates.
Function cItemsToPick(NrOfItems As Long, NrToPick As Long) As Collection
Dim cItemsTotal As New Collection
Dim K As Long
Dim I As Long
Set cItemsToPick = New Collection
If NrToPick > NrOfItems Then Exit Function
For I = 1 To NrOfItems
cItemsTotal.Add I
Next I
For I = 1 To NrToPick
K = Int(cItemsTotal.Count * Rnd + 1)
cItemsToPick.Add cItemsTotal(K)
cItemsTotal.Remove (K)
Next I
Set cItemsTotal = Nothing
End Function
You can test this function with the following code:
Sub test()
Dim c As New Collection
Dim I As Long
Set c = cItemsToPick(240, 10)
For I = 1 To c.Count
Debug.Print c(I)
Next I
End Sub
Is there any way by which we can get each character from a string using VBScript? I had used the Mid function but I just want to know if there are any other direct functions which when used returns each character starting from a string.
strString = "test"
For i=1 To Len(strString)
WScript.Echo Mid(strString,i,1)
Next
a="abcd"
for i=1 to len(a)
msgbox right(left(a,i),1)
next
AFAIK, Mid is the only way to do this.
Another way to do it, starting from 0 :
str = "hola che"
x=Len(str)
text = ""
For i=0 to x-1 'x-1 is because it exceeds the actual length
text= text & Mid(str,i+1,1)
Next
msgbox text
This code is useful to split Ucase and Lcase
Dim a
a="StAcKoVeRfLoW"
for i=o to len(a)-1
if mid(a,i+1,1)=ucase(mid(a,i+1,1)) then
b=mid(a,i+1,1)
msgbox b
end if
next
This works for me. LEFT and then RIGHT....
'Ugandan National Identity Number (NIN) has 14 digits
strFullNIN = "18650929392010"
strNIN_1 = LEFT(strFullNIN,1)
strNIN_2 = RIGHT(LEFT(strFullNIN,2),1)
strNIN_3 = RIGHT(LEFT(strFullNIN,3),1)
strNIN_4 = RIGHT(LEFT(strFullNIN,4),1)
strNIN_5 = RIGHT(LEFT(strFullNIN,5),1)
strNIN_6 = RIGHT(LEFT(strFullNIN,6),1)
strNIN_7 = RIGHT(LEFT(strFullNIN,7),1)
strNIN_8 = RIGHT(LEFT(strFullNIN,8),1)
strNIN_9 = RIGHT(LEFT(strFullNIN,9),1)
strNIN_10 = RIGHT(LEFT(strFullNIN,10),1)
strNIN_11 = RIGHT(LEFT(strFullNIN,11),1)
strNIN_12 = RIGHT(LEFT(strFullNIN,12),1)
strNIN_13 = RIGHT(LEFT(strFullNIN,13),1)
strNIN_14 = RIGHT(LEFT(strFullNIN,14),1)
If I didn't know the length of the initial string, I would do as follows:
strFullNIN = RS.fields("Client_NIN")
strFullNIN_LENGTH = LEN(strFullNIN)
x = 1
DO UNTIL x = strFullNIN_LENGTH
IF x = 1 THEN
strNIN_"& x &" = LEFT(strFullNIN,x)
ELSE
strNIN_"& x &" = RIGHT(LEFT(strFullNIN,x),1)
END IF
x=x+1
LOOP
Hope this is helpful to someone!