I am currently having issues with trying to get a list of integers to show in a listbox.
I have more numbers to show, however i cant even get one number to show.
There is no error, the listbox but shows this System.Collections.Generic.List'1[System.Int32]
Dim URL = New Uri("http://www.hurriyet.com.tr/sans-oyunlari/sans-topu-sonuclari/")
Dim WebClient As New HttpClient
Dim Source = Await WebClient.GetStringAsync(URL)
Dim ListofNumber As List(Of Integer)
ListofNumber = New List(Of Integer)
Dim WebCode1 As String = "<span id=""_ctl0_ContentPlaceHolder1_lblresutone"" class=""hurriyet2010_so_sanstopu_no_text"">([^>]*)</span></div>"
For Each item As Match In (New Regex(WebCode1)).Matches(Source)
ListofNumber.Add(item.Groups(1).Value)
Next
listBox1.Items.Add(ListofNumber)
Currently you're adding a single item to the list, which is the List(Of Integer) object. You need to add each item in the list separately, like this:
For Each i As Integer In ListOfNumber
listBox1.Items.Add(i)
Next
Or, more simply:
listBox1.Items.AddRange(ListOfNumber)
As was already mentioned in the comments, but bears repeating, regex is typically the wrong tool for the job when you're parsing HTML. Using an HTML parser/DOM would be preferable in most cases.
Instead of:
listBox1.Items.Add(ListofNumber)
...it should be:
listBox1.DataSource = ListofNumber
This way you are binding your list of objects (in your case ListofNumber) to the listBox.
In fact you can bind any type of list, and the result shown in the listBox will be the .ToString() of each one of the items (in your case: int.ToString(), which is the string of the number).
An alternative to bind the data source would be: listBox1.Items.Clear(), and then add your items one by one through listBox1.Items.Add(yourItem), or as a group with listBox1.Items.AddRange(ListofNumber).
I believe the issue is with the ID on WebCode1 as ID's are meant to be used once and that is the case in the source downloaded.
Please try this
Dim URL = New Uri("http://www.hurriyet.com.tr/sans-oyunlari/sans-topu-sonuclari/")
Dim WebClient As New HttpClient
Dim Source = Await WebClient.GetStringAsync(URL)
Dim WebCode1 As String = "class=""hurriyet2010_so_sanstopu_no_text"">([^>]*)</span></div>"
ListBox1.DataSource =
(
From T In (New Regex(WebCode1)).Matches(Source) _
.Cast(Of System.Text.RegularExpressions.Match)() _
Select T.Groups(1).Value) _
.ToList
Related
I have a system that I can output a spreadsheet from. I then take this outputted spreadsheet and import it into MS Access. There, I run some basic update queries before merging the final result into a SharePoint 2013 Linked List.
The spreadsheet I output has an unfortunate Long Text field which has some comments in it, which are vital. On the system that hosts the spreadsheet, these comments are nicely formatted. When the spreadsheet it output though, the field turns into a long, very unpretty string like so:
09:00 on 01/03/2017, Firstname Surname. :- Have responded to request for more information. 15:12 on 15/02/2017, Firstname Surname. :- Need more information to progress request. 17:09 on 09/02/2017, Firstname Surname. :- Have placed request.
What I would like to do is run a query (either in MS Access or MS Excel) which can scan this field, detect occurrences of "##:## on ##/##/####, Firstname Surname. :-" and then automatically insert a line break before them, so this text is more neatly formatted. It would obviously skip the first occurrence of this format, as otherwise it would enter a new line at the start of the field. Ideal end result would be:
09:00 on 01/03/2017, Firstname Surname. :- Have responded to request
for more information.
15:12 on 15/02/2017, Firstname Surname. :- Need more information to progress request.
17:09 on 09/02/2017, Firstname Surname. :- Have placed request.
To be honest, I haven't tried much myself so far, as I really don't know where to start. I don't know if this can be done without regular expressions, or within a simple query versus VBA code.
I did start building a regular expression, like so:
[0-9]{2}:[0-9]{2}\s[o][n]\s[0-9]{2}\/[0-9]{2}\/[0-9]{4}\,\s
But this looks a little ridiculous and I'm fairly certain I'm going about it in a very unnecessary way. From what I can see from the text, detecting the next occurrence of "##:## on ##/##/####" should be enough. If I take a new line after this, that will suffice.
You have your RegExp pattern, now you need to create a function to append found items with your extra delimiter.
look at this function. It takes, your long string and finds your date-stamp using your pattern and appends with your delimiter.
Ideally, i would run each line twice and add delimiters after each column so you have a string like,
datestamp;firstname lastname;comment
you can then use arr = vba.split(text, ";") to get your data into an array and use it as
date-stamp = arr(0)
name = arr(1)
comment = arr(2)
Public Function FN_REGEX_REPLACE(iText As String, iPattern As String, iDelimiter As String) As String
Dim objRegex As Object
Dim allmatches As Variant
Dim I As Long
On Error GoTo FN_REGEX_REPLACE_Error
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Multiline = True
.Global = True
.IgnoreCase = True
.Pattern = iPattern
If .test(iText) Then
Set allmatches = .Execute(iText)
If allmatches.count > 0 Then
For I = 1 To allmatches.count - 1 ' for i = 0 to count will start from first match
iText = VBA.Replace(iText, allmatches.item(I), iDelimiter & allmatches.item(I))
Next I
End If
End If
End With
FN_REGEX_REPLACE = Trim(iText)
Set objRegex = Nothing
On Error GoTo 0
Exit Function
FN_REGEX_REPLACE_Error:
MsgBox Err.description
End Function
use above function as
mPattern = "[0-9]{2}:[0-9]{2}\s[o][n]\s[0-9]{2}\/[0-9]{2}\/[0-9]{4}\,"
replacedText = FN_REGEX_REPLACE(originalText,mPattern,vbnewline)
Excel uses LF for linebreaks, Access uses CRLF.
So it should suffice to run a simple replacement query:
UPDATE myTable
SET LongTextField = Replace([LongTextField], Chr(10), Chr(13) & Chr(10))
WHERE <...>
You need to make sure that this runs only once on newly imported records, not repeatedly on all records.
I'm hoping I can get come help from a programmer.
What I want to do is to translate a word report generated by a software, so I turned to macros. I already have a word file containing the original word/phrases and the translated ones.
I 'stole' the code to translate from some forum online, which works great with normal text. My problem is that the text of the report I want to translate is within various "text boxes" and "tables".
I was able to manually remove the tables, but keep the text. This totally ruined the formatting, but I can deal with that latter.
Now, unfortunately I cannot do the same with textboxes. There is no 'delete, but keep the text" function for textboxes.
I can send you the macro code, the original report automatically generated by the software and the file to get all translated words from.
I really appreciate your time.
Ok. This is code that translates normal text.
Sub Translate()
Dim oChanges As Document, oDoc As Document
Dim oTable As Table
Dim oRng As Range
Dim rFindText As Range, rReplacement As Range
Dim i As Long
Dim sFname As String
'Change the path in the line below to reflect the path of the table document
sFname = "C:\Users\user\Desktop\Dictionary.doc"
Set oDoc = ActiveDocument
Set oChanges = Documents.Open(FileName:=sFname, Visible:=False)
Set oTable = oChanges.Tables(1)
For i = 1 To oTable.Rows.Count
Set oRng = oDoc.Range
Set rFindText = oTable.Cell(i, 1).Range
rFindText.End = rFindText.End - 1
Set rReplacement = oTable.Cell(i, 2).Range
rReplacement.End = rReplacement.End - 1
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(findText:=rFindText, _
MatchWholeWord:=True, _
MatchWildcards:=False, _
Forward:=True, _
Wrap:=wdFindContinue) = True
oRng.Text = rReplacement
Loop
End With
Next i
oChanges.Close wdDoNotSaveChanges
End Sub
I'm guessing you'd need to see the format of the document that is being translated, which contains all the tables and text boxes. But it is too large and I'm not sure if I can send it as an attachment here somehow. (sorry, its my first time on this forum). Any advise?
Thanks a lot
JD
Using Excel 2010. I want to only allow values in a cell that fit a given regex pattern. So I created a UDF module as follows:
Public re as RegExp
Public Function isValidRegex(rng As Range, pattern As String) As Boolean
If re Is Nothing Then
Set re = New RegExp
End If
re.pattern = pattern
isValidRegex = re.Test(rng.value)
End Function
I created a named range called THIS_CELL, so that the current cell can be passed to isValidRegex(), as follows:
=INDIRECT(ADDRESS(ROW(),COLUMN()))
I set a custom validation for the cell, using this formula:
=isValidRegex(THIS_CELL,"(my|regex)patt[ern]")
This generated the following error:
A named range you specified cannot be found.
According to this article, UDFs cannot be used in Custom validation formulas. The solution suggested in the article (putting the formula in another cell, making that cell into a named range, and referencing that cell in the Custom formula) won't work, because I need to be able to pass THIS_CELL as an argument to the function.
I also tried creating a named range called isValidRegexPattern, defining it as =isValidRegex(THIS_CELL,"(my|regex)patt[ern]"), and setting the Custom formula to =isValidRegexPattern, but this didn't work either; putting a breakpoint in isValidRegex() showed that the function wasn't even being called.
So, how can I use a UDF for cell validation?
You can use a static variable with the Worksheet_Change event to keep a snapshot of the prior values
The code below tracks the values in A1:A10 and uses a Regexp like yours to reject any non-numeric entries
The example below tries top copy and paste B1:B10 over A1:A10, only A6and A8 are allowed as they are numeric
to set the range initially change a cell outside the range of interest to trigger If IsEmpty(X) Then X = [a1:a10].Value2
change event
Private Sub Worksheet_Change(ByVal Target As Range)
Static X As Variant
Dim rng2 As Range
Dim rng3 As Range
If IsEmpty(X) Then X = [a1:a10].Value2
Set rng2 = Intersect([a1:a10], Target)
If rng2 Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each rng3 In rng2
If Not isValidRegex(rng3, "\d+") Then rng3.Value = X(rng3.Row, 1)
Next
Application.EnableEvents = True
X = [a1:a10].Value2
End Sub
regexp
Function isValidRegex(rng As Range, pattern As String) As Boolean
Dim re As Object
Set re = CreateObject("vbscript.regexp")
re.pattern = pattern
isValidRegex = re.Test(rng.Value)
End Function
You seem to be reluctant to move over to a WorksheetChange event macro because you believe it does not 'capture the pre-change state of the cell'. That may be correct in the strictest definition but that doesn't mean you cannot capture the changed state, undo the change, determine whether the change is valid and only re-apply the change if it meets criteria.
I'm not going to produce a full regex validating function. This simply tests if the number typed into column E is less than zero or blank. If not then the cell reverts to its prechange state.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Columns(5)) Is Nothing Then
If Not IsEmpty(Target) Then
On Error GoTo Safe_Exit
Application.EnableEvents = False
Dim vNEW As Variant
vNEW = Target.Value
Application.Undo
If bIs_It_Valid(vNEW) Then
Target = vNEW
Else
' put stuff like idiot warnings here
End If
End If
End If
Safe_Exit:
Application.EnableEvents = True
End Sub
Private Function bIs_It_Valid(val As Variant) As Boolean
If IsNumeric(val) Then _
bIs_It_Valid = CBool(val < 0)
Debug.Print bIs_It_Valid
End Function
That Worksheet_Change could probably be adjusted to work on a range of cells if pasting a number of values is important.
Here's how I accomplished this without using the Worksheet_Change event
Define a Public REGEX Function in a new Module
'Public REGEX Formula
Public Function REGEX(pattern As String, cel As Range) As Boolean
Dim re As New RegExp
re.pattern = pattern
REGEX = re.Test(cel.Value)
End Function
I added this Sub to a module I named Validations. This Sub requires not only the range to validate and the regular expression pattern, but also another range to apply the REGEX formula to. The actual validation applied actually only checks that separate cell for a True or False value. This is a simplified version that assumes the validationColumn is an entire column.
'Validations Module
Sub regexValidation(cells As Range, pattern As String, validationColumn As Range, defaultValue As String)
Dim cel As Range, regexFormula As String, validationCell As Range
cells.Value = defaultValue
'Need to match true on default value or validation will always fail
pattern = "(" & defaultValue & ")|(" & pattern & ")"
For Each cel In cells
regexFormula = "=REGEX(""" & pattern & """," & cel.address & ")"
Set validationCell = validationColumn.cells(cel.Row, 1)
validationCell.Formula = regexFormula
cel.Validation.Delete
cel.Validation.Add xlValidateCustom, Formula1:="=" & Trim(validationCell.address)
Next cel
End Sub
This is how I'm calling it. In my case, this is a UserForm with a TextBox called regexPattern that contains the regular expression to apply.
'Form
Private Sub applyRegexValidation(cells As Range)
Validations.regexValidation cells, regexPattern.text, validationColumn:=cells.Parent.Range("AA:AA"), defaultValue:="Required Custom"
End Sub
I am trying to to use list(of someclass) to keep track of an array of simular data for use at a later time in the program by using the .add() property. When I do I always get back the last item entered.
Dim lst as new list(of superclass)
Dim work as new list(of superclass)
Program execution to fill work before storage.
Lst.add(work)
Then list the list
For each wrk in lst
Print(lst)
Next
Try printing wrk instead of lst.
I'm working with 7 dynamic dependent lists, and I thought the best way to automate the process and avoid to arrange anything in a future if I modify the lists was a VBA code.
The VBA code that I started to work on it is posted on: Dynamic Depending Lists in Separated WorkSheets in VBA
That code is just for the 2 first lists.
That's the main table that I have. I want pick lists for the first row only for the yellow columns:
That's the table that I have the lists (they must be dynamic):
The relations between my lists are:
Responsible list and Site list are related with Project list.
The other lists are related with the site list.
Okay. I've got what you are looking for. I solved this issue a few months back in another project. Basically, indirect is no good here because it doesn't work on dynamic named ranges, because they don't produce an actual result, just a formula reference.
First, set up your named ranges on a sheet like so. It's very important that the named ranges be named in the manner I described, as this will feed the code into making your dynamic lists. Also, note, I only wrote out SamplePoints for X1 and T2. If you select other options, the code won't work until you add those named ranges in.
Then assuming input sheet is set up like below:
Place this code in the worksheet change event of your input sheet. What it does is take the value selected in one cell and then appends the appropriate column name to feed that list. So, if Project A is selected and you want to pick a responsible party for project A, it sets the validation in Range("B(whatever row you are on)" to be A_Responsible, thus giving you that list.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wks As Worksheet
Dim strName As String, strFormula
Dim rng As Range
Set wks = ActiveSheet
With wks
If Target.Row = 1 Then Exit Sub
Select Case Target.Column
Case Is = .Rows(1).Find("Project", lookat:=xlWhole).Column
Set rng = Target.Offset(, 1)
strName = Target.Value
strFormula = "=" & Replace(strName, " ", "_") & "_Responsible"
AddValidation rng, 1, strFormula
'add any more cells that would need validation based on project selection here.
Case Is = .Rows(1).Find("Responsible", lookat:=xlWhole).Column
Set rng = Target.Offset(, 1)
strName = Target.Value
strFormula = "=" & Replace(strName, " ", "_") & "_SamplePoint"
AddValidation rng, 1, strFormula
'add any more cells that would need validation based on responsible selection here.
'Case Is = add any more dependenices here ... and continue with cases for each one
End Select
End With
You will also need this function in a standard module somewhere in your workbook.
Function AddValidation(ByVal rng As Range, ByVal iOperator As Integer, _
ByVal sFormula1 As String, Optional iXlDVType As Integer = 3, _
Optional iAlertStyle As Integer = 1, Optional sFormula2 As String, _
Optional bIgnoreBlank As Boolean = True, Optional bInCellDropDown As Boolean = True, _
Optional sInputTitle As String, Optional sErrorTitle As String, _
Optional sInputMessage As String, Optional sErrorMessage As String, _
Optional bShowInput As Boolean = True, Optional bShowError As Boolean = True)
'==============================================
'Enumaration for ease of use
'XlDVType
'Name Value Description
'xlValidateCustom 7 Data is validated using an arbitrary formula.
'xlValidateDate 4 Date values.
'xlValidateDecimal 2 Numeric values.
'xlValidateInputOnly 0 Validate only when user changes the value.
'xlValidateList 3 Value must be present in a specified list.
'xlValidateTextLength 6 Length of text.
'xlValidateTime 5 Time values.
'xlValidateWholeNumber 1 Whole numeric values.
'AlertStyle
'xlValidAlertInformation 3 Information icon.
'xlValidAlertStop 1 Stop icon.
'xlValidAlertWarning 2 Warning icon.
'Operator
'xlBetween 1 Between. Can be used only if two formulas are provided.
'xlEqual 3 Equal.
'xlGreater 5 Greater than.
'xlGreaterEqual 7 Greater than or equal to.
'xlLess 6 Less than.
'xlLessEqual 8 Less than or equal to.
'xlNotBetween 2 Not between. Can be used only if two formulas are provided.
'xlNotEqual 4 Not equal.
'==============================================
With rng.Validation
.Delete ' delete any existing validation before adding new one
.Add Type:=iXlDVType, AlertStyle:=iAlertStyle, Operator:=iOperator, Formula1:=sFormula1, Formula2:=sFormula2
.IgnoreBlank = bIgnoreBlank
.InCellDropdown = bInCellDropDown
.InputTitle = sInputTitle
.ErrorTitle = sErrorTitle
.InputMessage = sInputMessage
.ErrorMessage = sErrorMessage
.ShowInput = bShowInput
.ShowError = bShowError
End With
End Function