i'm splitting the string ;#WR_1;#WR_2;#WR_3;#WR_4;# with VBA code
Sub Splitfn()
Dim str As String
Dim var As Variant
Dim i As Long
str = ";#WR_1;#WR_2;#WR_3;#WR_4;#"
var = Split(str, ";#")
For i = 0 To UBound(var)
Debug.Print i, var(i)
Next i
End Sub
That returns
0
1 WR_1
2 WR_2
3 WR_3
4 WR_4
5
I want to add these values(WR_1,WR_2,WR_3,WR_4) to dropdown list. How to specify that in VBA code
Combo boxes accept strings as a value list:
sStr = ";#WR_1;#WR_2;#WR_3;#WR_4;#"
'' Var = Split(Str, ";#")
sStr = Replace(sStr, "#", "")
Me.Combo9.RowSourceType = "value list"
Me.Combo9.RowSource = sStr
The first value will be empty, because the first character is the delimiter ;, if this is not required, it is easy to change:
sStr=Mid(sStr,2)
Me.Combo9.RowSource = sStr
Related
I have a multiselect listbox that has around 60 values, the user can go through and select anything they want I can successfully read everything selected and output it as one line like this "1,2,3,4,5" and store that value. The problem I currently have is when the user needs to edit what was selected. How can I reselect the listbox items based on the string "1,2,3,4,5" that was stored earlier?
I figured it out after a lot of searching, here is the code
Dim strValue As String
Dim strArray() As String
Dim x As Integer
Dim startRow As Integer
strValue = rsPrints("ctype")'Get string of row values
strArray = Split(strValue, ",", -1, vbTextCompare)'My string required splitting to remove commas and moving to an array
x = 0 'Set array start point to 0
For Q = LBound(strArray) To UBound(strArray) 'Run through array
startRow = strArray(x)
Me.formctype.Selected(startRow) = True
x = x + 1
Next
Is there a way of taking html code for a table and printing out the same table in a word document using VBA (VBA should be able to parse the html code block for a table)?
It is possible to take the contents of the table and copy them into a new table created in Word, however is it possible to recreate a table using the html code and vba?
For any of this, where can one begin to research?
EDIT:
Thanks to R3uK: here is the first portion of the VBA script which reads a line of html code from a file and uses R3uK's code to print it to the excel worksheet:
Private Sub button1_Click()
Dim the_string As String
the_string = Trim(ImportTextFile("path\to\file.txt"))
' still working on removing new line characters
Call PrintHTML_Table(the_string)
End Sub
Public Function ImportTextFile(strFile As String) As String
' http://mrspreadsheets.com/1/post/2013/09/vba-code-snippet-22-read-entire-text-file-into-string-variable.html
Open strFile For Input As #1
ImportTextFile = Input$(LOF(1), 1)
Close #1
End Function
' Insert R3uK's portion of the code here
This could be a good place to start, you will only need to check content after to see if there is any problem and then copy it to word.
Sub PrintHTML_Table(ByVal StrTable as String)
Dim TA()
Dim Table_String as String
Table_String = " " & StrTable & " "
TA = SplitTo2DArray(Table_String, "</tr>", "</td>")
For i = LBound(TA, 1) To UBound(TA, 1)
For j = LBound(TA, 2) To UBound(TA, 2)
ActiveSheet.Cells(i + 1, j + 1) = Trim(Replace(Replace(TA(i, j), "<td>", ""), "<tr>", ""))
Next j
Next i
End Sub
Public Function SplitTo2DArray(ByRef StringToSplit As String, ByRef RowSep As String, ByRef ColSep As String) As String()
Dim Rows As Variant
Dim rowNb As Long
Dim Columns() As Variant
Dim i As Long
Dim maxlineNb As Long
Dim lineNb As Long
Dim asCells() As String
Dim j As Long
' Split up the table value by rows, get the number of rows, and dim a new array of Variants.
Rows = Split(StringToSplit, RowSep)
rowNb = UBound(Rows)
ReDim Columns(0 To rowNb)
' Iterate through each row, and split it into columns. Find the maximum number of columns.
maxlineNb = 0
For i = 0 To rowNb
Columns(i) = Split(Rows(i), ColSep)
lineNb = UBound(Columns(i))
If lineNb > maxlineNb Then
maxlineNb = lineNb
End If
Next i
' Create a 2D string array to contain the data in <Columns>.
ReDim asCells(0 To maxlineNb, 0 To rowNb)
' Copy all the data from Columns() to asCells().
For i = 0 To rowNb
For j = 0 To UBound(Columns(i))
asCells(j, i) = Columns(i)(j)
Next j
Next i
SplitTo2DArray = asCells()
End Function
I have a pop-up window in Microsoft Access containing text box fields that are required to be filled out by the user, for example:
First Name:
Last Name:
Now I'm trying to create a button that when clicked would look into C:\mytextfile.txt
and auto-populate those fields.
inside the text file it would look like this:
##$##%#$543%#$%#$$#%LAST NAME:BOB#$##$##$##$##FIRST NAME:DERRICK$#%$#%$#%#$%$#%$#
So essentially I'm looking for 3 things:
to access the text file
to parse for the data
to populate it into the text boxes. (The data doesn't need to go into a table until the "SAVE" button is clicked")
Update:
This is what I've written so far, I'm not sure why it's not working.
Private Sub LoadText_Click()
Dim myFile As String myFile = "C:\myFile.txt"
Me.NameofTextbox = Mid(myFile, 7, 3)
End Sub
Here example for file you provided and controls on Form that are named txtboxLastName and txtboxFirstName
Dim mFields() As String ' array with fields' names in file
Dim mControls() As String ' corresponding controls' names
Dim mStopChars() As String ' Characters that put after values
Dim tmpstr As String
Dim content As String
Dim i As Long
Dim fStart As Long
Dim valStart As Long
Dim valEnd As Long
Dim FieldValue As String
Dim j As Long
Dim tmp As Long
' prepare maps
' here : included in field name for common case
mFields = Split("LAST NAME:,FIRST NAME:", ",")
mControls = Split("txtboxLastName,txtboxFirstName", ",")
mStopChars = Split("#,$,#,%", ",")
' read file into string
Open "c:\mytextfile.txt" For Input As #1
Do While Not EOF(1)
Input #1, tmpstr
content = content & tmpstr
Loop
Close #1
' cycle through fields and put their values into controls
For i = LBound(mFields) To UBound(mFields)
fStart = InStr(1, content, mFields(i))
If fStart > 0 Then
valStart = fStart + Len(mFields(i)) 'value start at this pos
'cycle through possible stop chars to locate end of current value
valEnd = Len(content)
For j = LBound(mStopChars) To UBound(mStopChars)
tmp = InStr(valStart, content, mStopChars(j))
If tmp > 0 Then
If tmp <= valEnd Then
valEnd = tmp - 1
End If
End If
Next j
' cut value
FieldValue = Mid(content, valStart, valEnd - valStart + 1)
' assign to control
Me.Controls(mControls(i)).Value = FieldValue
End If
Next i
Info: Excel 2010
Notes: The code works exactly how I need, I am now wanting to automate it a little
I recently came across this code, it's for a custom function, however I can not create a button for it (like a macro), I would like to convert some of this code, however I don't know what to do or how to go about it. I want to have a shortcut/button on my ribbon.
https://stackoverflow.com/a/17337453/2337102
Function listUnique(rng As Range) As Variant
Dim row As Range
Dim elements() As String
Dim elementSize As Integer
Dim newElement As Boolean
Dim i As Integer
Dim distance As Integer
Dim result As String
elementSize = 0
newElement = True
For Each row In rng.Rows
If row.Value <> "" Then
newElement = True
For i = 1 To elementSize Step 1
If elements(i - 1) = row.Value Then
newElement = False
End If
Next i
If newElement Then
elementSize = elementSize + 1
ReDim Preserve elements(elementSize - 1)
elements(elementSize - 1) = row.Value
End If
End If
Next
distance = Range(Application.Caller.Address).row - rng.row
If distance < elementSize Then
result = elements(distance)
listUnique = result
Else
listUnique = ""
End If
End Function
Results with the ability to:
Just enter =listUnique(range) to a cell. The only parameter is range
that is an ordinary Excel range. For example: A$1:A$28 or H$8:H$30.
I would like the following:
Create a macro button with an a popup Inputbox to ask for a range.
Usage:
1) I am in the cell where I require the list to begin (BA9)
2) I click the custom module/macro button & popup box asks me the range (G$8:G$10000)
3) The result then autofills in column (BA)
Lastly, can the code be amended so that the restriction of "The first cell where you call the function must be in the same row where the range starts." be removed so that I can use a reference from another sheet within the same workbook.
I apologise if I should have gone direct to the coder, the thread that it was in is old & I thought given the amount of change I'm asking for it may be better suited in its own question.
Thank you in advance.
First approach: (you can use RemoveDuplicates method instead function listUnique)
Just assign this Sub to your custom button:
Sub testRemoveDuplicates()
Dim targetRange As Range
Dim actCell As Range
Dim res As Variant
Set actCell = ActiveCell
On Error Resume Next
Set targetRange = Application.InputBox("Please highlight the cell for TARGET", Type:=8)
On Error GoTo 0
If targetRange Is Nothing Then
MsgBox "User has pressed cancel"
Exit Sub
End If
targetRange.Copy
actCell.PasteSpecial xlPasteValues
actCell.RemoveDuplicates Columns:=1, Header:=xlNo
Application.CutCopyMode = False
End Sub
Second approach: (if you'd like to use function listUnique)
Here is another listUnique function. You can get list of unique elements usign Dictionary object (it is better suited for your purposes):
Function listUnique(rng As Range) As Variant
Dim row As Range
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
On Error Resume Next
For Each row In rng.Rows
If row.Value <> "" Then
dict.Add row.Value, row.Value
End If
Next
Dim res As Variant
ReDim res(1 To dict.Count)
res = dict.Items
Set dict = Nothing
listUnique = Application.Transpose(res)
End Function
then you can call it using following Sub (you can assign it to custom button):
Sub test()
Dim targetRange As Range
Dim actCell As Range
Dim res As Variant
Set actCell = ActiveCell
On Error Resume Next
Set targetRange = Application.InputBox("Please highlight the cell for TARGET", Type:=8)
On Error GoTo 0
If targetRange Is Nothing Then
MsgBox "User has pressed cancel"
Exit Sub
End If
res = listUnique(targetRange)
actCell.Resize(UBound(res)) = res
End Sub
Note: if you're going to call this listUnique function direct from worksheet (as UDF function), you should select destination range (in example D10:D20), with selected range enter formula =listUnique(A1:A10) in formula bar, and press CTRL+SHIFT+ENTER to evaluate it.
I need help creating a VB code or expression in Access 2010 that will group numbers from a string where each set starts with number 6 and is always 9 characters long.
Example of strings:
Order Confirmation # 638917872-001 Partial Order/$23.74 RECEIVED
Order Confirmation - Multiple Orders - Order Confirmation#639069135-001/$297.45 - Order Confirmation#639069611-001/$32.08.
I'm using a VB code to remove all the alpha characters but that just leaves me with:
6389178720012374 from string 1 and
639069135001297456390696110013208 from string 2.
All I care about is the order number that starts with 6 and is 9 characters long. Any help would be greatly appreciated, I know there's an easier way.
VB.NET Solution:
If you just need the first 9 numbers from your resulting strings you could use String.Substring, ie:
Dim numberString as String = "6389178720012374"
Dim newString As String = numberString.Substring(0, 9)
MessageBox.Show(newString)
shows 638917872
MSDN Link
EDIT:
Maybe you would want to use a RegEx - something like this perhaps can get you started:
Private Sub Input()
Dim numberString As String = "Order Confirmation # 638917872-001 Partial Order/$23.74 RECEIVED"
Dim numberString2 As String = "Order Confirmation - Multiple Orders - Order Confirmation#639069135-001/$297.45 - Order Confirmation#639069611-001/$32.08"
GiveMeTheNumbers(numberString)
GiveMeTheNumbers(numberString2)
End Sub
Function GiveMeTheNumbers(ByVal s As String) As String
Dim m As Match = Regex.Match(s, "6\d{8}") 'get 9 digit #s begin w/6
Do While m.Success
MessageBox.Show(m.Value.ToString)
m = m.NextMatch()
Loop
Return False
End Function
Results -
MessageBox1: 638917872
MessageBox2: 639069135
MessageBox3: 639069611
You can use this function ... tested in VB.NET
Function NumOnly(ByVal s As String) As String
sRes = ""
For x As Integer = 0 To s.Length - 1
If IsNumeric(s.Substring(x, 1)) Then sRes = sRes & s.Substring(x, 1)
Next
return sRes
End Function
Little modif for ms-access
OK, here's a VBA solution. You'll need to add Microsoft VBScript Regular Expressions to your references.
This will match every 9 digit number it finds and return an array of strings with the order #s.
Function GetOrderNum(S As String) As String()
Dim oMatches As Object
Dim aMatches() As String
Dim I As Integer
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
ReDim aMatches(0)
RE.Pattern = "\d{9}"
RE.Global = True
RE.IgnoreCase = True
Set oMatches = RE.Execute(S)
If oMatches.Count <> 0 Then
ReDim aMatches(oMatches.Count)
For I = 0 To oMatches.Count - 1
aMatches(I) = oMatches(I)
Next I
End If
GetOrderNum = aMatches
End Function