I have some ComboBoxes on my FORM. One of them have items as a result of SQL request from field PG (cbPG.RowSource = "SELECT DISTINCT W_report.PG FROM W_report WHERE ......) The size of the field is byte.
After reqest
User can select one of the variant or can list several comma-separated (2,4,5,7,11,13).
Correct value
The resulting ComboBox.value is used in a procedure similar to selecting pages for printing. Everything works correctly until changes are made to the event handler of cbPG. Then the values are automatically rounded (if one comma)
wrong value
or an error "The entered value is not appropriate for this field" occurs (if a few commas) and I have to copy cbPG from the backup because I can't find a property that changes format of cbPG.value to byte.
Here is part of program that use my ComboBox
Public Function MnogoListov(str As String) As String
Dim i, j As Integer
Dim res As String
Dim listArr() As String
res = ""
ReDim listArr(Len(str)) As String
For i = 1 To Len(str)
If Mid(str, i, 1) <> "," And Mid(str, i, 1) <> "." Then
listArr(j) = listArr(j) & Mid(str, i, 1)
Else
j = j + 1
End If
Next
For i = 0 To j
If i = 0 Then
res = listArr(i)
Else
res = res & " OR W_report.PG = " & listArr(i) End If
Next
MnogoListov = res
End Function
You can't do that. A combobox is for selecting one value from several.
So, either use a multi-select listbox or a simple textbox where you - similar to selecting pages for printing - parse the inputted values to obtain the sequence (list) of items (pages).
Related
Function ChewQuery(QueryList As String)
'This function takes in a string and partitions it into a weight tree
Dim ElementList() As String
ElementList = QueryList.Split(";")
Dim LoadedWeight(ElementList.Length) As WeightElement
For x = 0 To ElementList.Length - 1
'Using this method, in which the front portion of the query is repeatedly removed, allows for a simpler query structure, so that we don't need to partition between the pointers and values
LoadedWeight(x).LowPointer = Int(BiteQuery(ElementList(x)))
LoadedWeight(x).HighPointer = Int(BiteQuery(ElementList(x)))
LoadedWeight(x).TraitPointer = Int(BiteQuery(ElementList(x)))
LoadedWeight(x).Num = Int(BiteQuery(ElementList(x)))
ChewQueryValues(ElementList(x), LoadedWeight(x))
Next
Return LoadedWeight
End Function
Function BiteQuery(ByRef QueryList As String)
Dim Marker As Integer
Dim Bite As String
'This function partitions the input string around the first comma
'It returns the section before the comma, and stores the section behind the comma as the new value for the string
Try
Marker = InStr(QueryList, ",")
Bite = Left(QueryList, Marker - 1)
Marker = Len(QueryList) - Marker
QueryList = Right(QueryList, Marker)
Catch
'This is used in the case that a list without a comma is input
Bite = QueryList
QueryList = ""
End Try
Return Bite
End Function
Sub ChewQueryValues(ByRef QueryList As String, ByRef LoadedWeight As WeightElement)
LoadedWeight.Values = {}
While Len(QueryList) > 0
'This While loop is so that an arbitrary number of values can be inserted
'Because BiteQuery takes in functions by reference, each loop reduces the length of the string until it is empty
ReDim Preserve LoadedWeight.Values(LoadedWeight.Values.Length + 1)
LoadedWeight.Values(LoadedWeight.Values.Length - 1).TraitName = BiteQuery(QueryList)
LoadedWeight.Values(LoadedWeight.Values.Length - 1).TraitNum = Int(BiteQuery(QueryList))
LoadedWeight.Values(LoadedWeight.Values.Length - 1).WeightValue = CDec(BiteQuery(QueryList))
End While
End Sub
This set of functions is exhibiting some sort of undefined/random behavior when run in the following case:
FullToken = Strings.Right(Strings.Left(Query, 10), 5) 'This set of functions will extract the 5 rightmost characters of the 10 leftmost characters. This is equivalent to the 5th to 10th characters, which is where the token is stored
QueryText = Strings.Right(Query, Len(Query) - 11)
ReDim Preserve Weight(Weight.Length + 1)
Weight(Weight.Length - 1).Token = FullToken 'This puts the token in the list
Weight(Weight.Length - 1).Weight = ChewQuery(QueryText) 'This puts the weight in the list
WeightList.Text += vbCrLf + FullToken 'This adds the token to the viewable label
This is causing other important parts of the program to fail, which is not desirable. How do I fix this code so that it performs identically on each run of the program?
I have a large range that I need to find all numbers that is between four and six digits long.
I know I can use regex for this but I don't want to loop each cell and check them all.
What I need is kind of selecting the range copy and paste in notepad and copy back to a variable.
This way I can regex the variable and find all matches at once.
I don't need to know where the number was found, I just need the numbers.
Is there any way to copy the values to a string like this?
Dim text As String
text = ActiveSheet.Range("C9:IQ56").Value
is not compatible datatypes.
If I use variant I get an array of the columns and cells.
My attempt to join the array is not successful either.
text = ActiveSheet.Range("C9:IQ56").Value
textstring = ""
For i = 1 To UBound(text, 1)
textstring = textstring & " " & Join(text(i))
Next i
Any help with this?
use Application Index to do each row at a time:
text = ActiveSheet.Range("C9:IQ56").Value
textstring = ""
For i = 1 To UBound(text, 1)
textstring = textstring & " " & Join(application.Index(text,i,0))
Next i
There are two problems in your code, the declaration and the dimensions of the variable. Here is what you can do:
Dim Text() As Variant
Text = ActiveSheet.Range("C9:IQ56").Value
textstring = ""
For i = 1 To UBound(Text, 1)
For j = 1 To UBound(Text, 2)
textstring = textstring & " " & Text(i, j)
Next j
Next i
Similar approach with delimiters concatenating row strings after loop
Added a Timer and the feature to use separators (delimiters) as well for rows (e.g. "|") as for columns (e.g. ","). Furthermore I demonstrate a way to join all row strings at once after loop via Application.Transpose() just for the sake of the art, though this isn't faster nor slower than #Scott Craner 's valid solution :+).
Code
Sub arr2txt()
Const SEPROWS As String = "|" ' << change to space or any other separator/delimiter
Const SEPCOLS As String = "," ' << change to space or any other separator/delimiter
Dim v
Dim textstring As String, i As Long
Dim t As Double: t = Timer ' stop watch
v = ActiveSheet.Range("C2:E2000").Value ' get data into 1-based 2-dim datafield array
For i = 1 To UBound(v, 1)
v(i, 1) = Join(Application.Index(v, i, 0), SEPCOLS)
Next i
textstring = Join(Application.Transpose(Application.Index(v, 0, 1)), SEPROWS)
Debug.Print Format(Timer - t, "0.00 seconds needed")
End Sub
I have the following data set, which contains duplicates.
values:
2880CR-20.36KX53305DECOAK2015
F05572-CN48517OCTOAK2016
F05572-CN48517DECOAK2016
F05572-CN48517NOVOAK2015
F05572-CN48517NOVOAK2015(duplicate)
F05572-CN48517DECOAK2015
F05573-CN48517JANOAK2016
F05573-CN48517FEBOAK2016
F05573-CN48517JANOAK2015
F05573-CN48517FEBOAK2015
F05573-CN48517MAROAK2015
F05573-CN48517APROAK2015
F05573-CN48517APROAK2015(duplicate)
I am trying to create a macro that will look at the values in column A, from A2:A (count of rows in column), and return a list of the duplicate values contained in the string declared "strMyDupList". Basically, if there is atleast 1 duplicate, the msgbox will pop up and the new sheet created with the columns address and values and I am trying to list out all the values seperated my a comma VERTICALLY, instead of horizontally across the sheet. so like:
Address value
$A$5 F05572-CN48517NOVOAK2015
$A$13 F05573-CN48517APROAK2015
my code is :
If strMyDupList <> "" Then
MsgBox "The following entries have been used more than once:" & vbNewLine & strMyDupList
Worksheets.Add.name = name
Worksheets(name).Range("A1").Value = "Location"
Worksheets(name).Range("B1").Value = "Value"
' Worksheets(name).Range("A2:C2").Value = Split(strMyDupList, ",")
Worksheets(name).Range("B4:B6") = Split(Application.WorksheetFunction.Transpose(strMyDupList), ",")
The results are that I am able to get the values tranposed from horizontal to vertical, however, with this code, it is only returning the FIRST VALUE in the list of values in the string, so it's returning:
Address value
$A$5 F05572-CN48517NOVOAK2015
$A$5 F05572-CN48517NOVOAK2015 (should be F05573-CN48517APROAK2015)
I've seen the UBound with Resize could work but I have no idea how the syntax works or is used. Can someone assist?
Thank you
Here is a complete example of how to leave duplicates out of your information.
Essentially, it sorts all of your information. Therefore, when you sort you'll get the consecutive value which would be itself if it was a dupe.
It uses a .NET feature, System.Collections.ArrayList, that was in 2.0 & 3.5 so that has to be installed on your machine. Usually it already is but it may not be. You can turn it on through Programs & Features.
Sub StringArrayDupeChecker()
Dim var As Variant
Dim holder As String
Dim strMyList() As String
Dim myDupeData As Variant
Dim str As String
str = "one,two,three,three,three,four,five,five"
strMyList = Split(str, ",")
holder = ""
Set var = CreateObject("System.Collections.ArrayList")
Set myDupeData = CreateObject("System.Collections.ArrayList")
For Each i In strMyList
var.Add (i)
Next i
var.Sort
For Each j In var
If Not j = holder Then
'do your stuff
str = "notDupe"
Else
myDupeData.Add(j)
End If
holder = j
Next j
End Sub
okay so i have two textboxes for user input, and i need help storing these into a single two dimensional array.
for 49 columns and two rows (states, capitals)
i already declared the array to:
Dim states(49,1) as string
states(0,0)= textbox1.text
states(0,1) = textbox2.text
im not sure what else to do because i have
am i storing this right? im not sure what more to do to store the rest of input into the array.
any help would be appreciated. thank you!
Declare module/class scope variables:
Dim states(49,1) as string
Dim nextInd as Integer = 0
Then in your button click handler:
If nextInd <= 49 Then ' Make sure you are not trying to fill values past the dimensions of the array
states(nextInd, 0) = textbox1.text
states(nextInd, 1) = textbox2.text
nextInd += 1 ' To increment the next index to use by 1
textbox1.text = ""
textbox2.text = ""
End If
And then to display the contents of the array, you need a loop:
' Use a string builder so you can modify the same string object to show it all together in the message box
Dim contents As New StringBuilder("")
For st = 0 To 49
contents.Append(states(st, 0) & ": " & states(st, 1) & Environment.NewLine)
' Or however you want To format it
Next
MessageBox.Show(Me, contents) ' MsgBox is old - use MessageBox instead
I want code to check one column of data for a condition ie: Range Qualification. If they are required to go the the Range the value will be "REQ" if they are not the values will be "E", "S", "M", and "NR". I use [select case] to check the condition. At the start of the select case I get this error.
I am not sure if I am making the sell reference right or not. After the array is populated with names from another column, I then go through and remove the empty elements from the array and then display all elements of the array in a msgbox. Below is the code I used:
'Declares total number of personnel as integer
Dim total As Integer
total = Worksheets("MASTER").Range("C4").Value
'Declares single element array with personnel full names
ReDim names(total) As String
'Loops through the array checking to see if personnel have qualified on the Rifle Range
For i = (1 + 6) To (total + 6)
Select Case Worksheets("MASTER").Range(Cells(i, 23)).Text
Case "REQ"
names(i - 6) = Worksheets("MASTER").Range(Cells(i, 7)).Value
Case "NR"
names(i - 6) = vbNullString
Case "E"
names(i - 6) = vbNullString
Case "S"
names(i - 6) = vbNullString
Case "M"
names(i - 6) = vbNullString
End Select
Next
'Declares a new array to remove blank elements from the orignal array
ReDim msgnames(LBound(names) To UBound(names))
'Loops through new array removing empty elements
For i = LBound(names) To UBound(names)
If names(i) <> vbNullString Then
x = x + 1
msgnames(x) = names(i)
End If
Next
'Displays every element of the array
For i = LBound(msgnames) To UBound(msgnames)
msg = msg & msgnames(i) & vbNewLine
Next
'Declares COMP, NOTCOMP, REQ and NOTREQ variables
Dim COMP As String
Dim NOTCOMP As String
Dim REQ As String
Dim NOTREQ As String
'Adds a comment to the bottom of the Message Box
MsgBox msg, vbOKOnly, "Rifle Range"`
You have the wrong syntax for your range.
Change this:
Select Case Worksheets("MASTER").Range(Cells(i, 23)).Text
to this:
Select Case Worksheets("MASTER").Cells(i, 23).Value2
One other thing -- you should use .value or .value2 instead of .text unless you have a very specific reason for using .text. See Charles Williams' article for an excellent analysis of the three properties: TEXT vs VALUE vs VALUE2 - Slow TEXT and how to avoid it.